      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F03.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 1, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F03 - FDAT - BOOK TABLE OF CONTENTS         *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM IS THE BOOK TABLE OF CONTENTS LIST *
      *             WHICH LIST'S ALL REPORTS WITHIN THE SELECTED    *
      *             BOOK ID AND DISTRIBUTION ID.                    *
      *                                                             *
      *   LANGUAGE: COBOL II / SQL / CICS                           *
      *                                                             *
      *   ENTRY:    CICS TRANSACTION ID "FD03" THRU "FDAT"          *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       T231ACS  - SECURITY ACCESS TABLE                      *
      *       T231SEC  - SECURITY DISTIRBUTION TABLE                *
      *       T231DIST - DISTRIBUTION TABLE                         *
      *       T231BOOK - BOOK TABLE                                 *
      *       T231RPT  - REPORT TABLE                               *
      *       T231LINE - LINE TABLE                                 *
      *       T231COL  - COLUMN TABLE                               *
      *       T231ORG  - ORGANIZATION TABLE                         *
      *       T231RGN  - REGION TABLE                               *
      *       T231PRIM - PRIME TABLE                                *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  B.W. MCNULTY   ORIGINAL VERSION.                *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

           EJECT
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  FILLER                      PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.
      **===========================================================**
      **   PROGRAM ID CONSTANTS                                    **
      **===========================================================**
       01  W0000-PROGRAM-INFO.
           05  PROGRAM-NAME            PIC  X(08)  VALUE 'P231F03'.
           05  MAP-NAME                PIC  X(08)  VALUE 'M231F03'.
           05  SET-NAME                PIC  X(08)  VALUE 'M231F03'.
           05  MAP-NAME-1              PIC  X(08)  VALUE 'M231F03'.
           05  MAP-NAME-A              PIC  X(08)  VALUE 'M231F3A'.
           05  MAP-NAME-B              PIC  X(08)  VALUE 'M231F3B'.
           05  MAP-NAME-C              PIC  X(08)  VALUE 'M231F3C'.
           05  MAP-NAME-D              PIC  X(08)  VALUE 'M231F3D'.
           05  TXN-ID                  PIC  X(04)  VALUE 'FD03'.
           05  MAP-DATA                PIC  X(1920)  VALUE SPACES.

           05  ERROR-FLAG              PIC  X(01)  VALUE 'N'.
               88  NO-ERRORS                       VALUE 'N'.
               88  ERRORS                          VALUE 'Y'.

           05  M-MSG-24I               PIC  X(80)  VALUE SPACES.

      **===========================================================**
      **   MISCELLANEOUS WORK FIELDS                               **
      **===========================================================**
           EJECT
       01  W0001-MISCELLANEOUS-FIELDS.
           05  W0001-PGM-XCTL-NO       PIC  X(08)  VALUE SPACES.
           05  W0001-TXN-ID            PIC  X(04)  VALUE SPACES.
           05  W0001-XCTL-PGM-ID       PIC  X(08)  VALUE 'P231F03'.
           05  W0001-LINK-PGM-ID       PIC  X(08)  VALUE 'P231F03'.
           05  W0001-LINK-CA           PIC  X(999) VALUE SPACES.
           05  W0001-SCREEN-LINE-LIMIT PIC S9(09)  COMP-3 VALUE +10.
           05  W0001-SCREEN-A-LN-LIMIT PIC S9(09)  COMP-3 VALUE +7.
           05  W0001-SCREEN-B-LN-LIMIT PIC S9(09)  COMP-3 VALUE +14.
           05  W0001-SCREEN-C-LN-LIMIT PIC S9(09)  COMP-3 VALUE +10.
           05  W0001-SCREEN-D-LN-LIMIT PIC S9(09)  COMP-3 VALUE +13.
           05  W0001-COPY-CTR          PIC S9(09)  COMP-3 VALUE +0.
           05  W0001-A-SEQ-N           PIC S9(09)  COMP   VALUE +0.

           05  W0001-ORDER-BY          PIC  X(02)  VALUE SPACES.

           05  W0001-ABSTIME           PIC S9(16)  COMP.
           05  W0001-HHCMMCSS.
               10  W0001-HR            PIC  X(02).
               10  W0001-C1            PIC  X(01).
               10  W0001-MIN           PIC  X(02).
               10  W0001-C2            PIC  X(01).
               10  W0001-SEC           PIC  X(02).
           05  W0001-MMSDDSYY.
               10  W0001-MON           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-DAY           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-YEAR          PIC  X(02).
           05  W0001-YYYY.
               10  W0001-YY            PIC  X(04).

           05  W0001-DB2-ZERO-DATE     PIC  X(10) VALUE '01/01/0001'.
           05  W0001-DB2-MAX-DATE      PIC  X(10) VALUE '12/31/9999'.
           05  W0001-DB2-DATE.
               10  W0001-DB2-MM        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH1     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-DD        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH2     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-CC        PIC  X(02)  VALUE '19'.
               10  W0001-DB2-YY        PIC  X(02)  VALUE '99'.
           05  W0001-MMYY-DATE.
               10  W0001-MM            PIC  X(02).
               10  W0001-YY            PIC  X(02).

           05  W0001-X                 PIC S9(09)  COMP.
           05  W0001-IX                PIC S9(09)  COMP.
           05  W0001-IX2               PIC S9(09)  COMP.

           05  W0001-SEQ-N                     PIC 9(02).
           05  W0001-SEQ REDEFINES W0001-SEQ-N PIC X(02).

           05  W0001-FISCAL-PERIOD.
               10  W0001-FISCAL-CC       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-YY       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-MM       PIC  X(02)  VALUE SPACES.

           05  W0001-FYPD.
               10  W0001-FYPD-YY         PIC  X(02)  VALUE SPACES.
               10  W0001-FYPD-MM         PIC  X(02)  VALUE SPACES.

           05  W0001-SELECTION-FLAG      PIC  X(01)  VALUE 'N'.
               88  W0001-LINES-SELECTED              VALUE 'Y'.
               88  W0001-NO-LINES-SELECTED           VALUE 'N'.

           EJECT
       01  W0002-T231ORGF.

           05  W0002-T231ORG-REC-TYPE-00.
               10  W0002-T231ORG-COMMENT-IND PIC X(01).
                   88  W0002-T231ORG-COMMENT-REC        VALUE '/'.
               10  W0002-T231ORG-COMMENT      PIC X(79).
               10  FILLER                     PIC X(11).

           05  W0002-T231ORG-REC-TYPE-01      REDEFINES
               W0002-T231ORG-REC-TYPE-00.
      *BWM*    10  W0002-F-ORG-C              PIC X(02).
               10  W0002-F-ORGLVL01-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL02-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL03-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL04-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL05-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL06-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL07-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL08-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL09-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL10-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL11-C         PIC X(03).
               10  FILLER                     PIC X(04).
      *        10  W0002-F-DFLTAFM-C          PIC X(02).
      *        10  FILLER                     PIC X(08).
               10  W0002-F-ORG-X              PIC X(31).

           05  W0002-T231ORG-REC-TYPE-02      REDEFINES
               W0002-T231ORG-REC-TYPE-00.
      *BWM*    10  W0002-F-ORG-C-02           PIC X(02).
               10  W0002-F-ORGROLLUP01-C      PIC X(02).
               10  W0002-ORG-RECTYP-C         PIC X(01).
                   88  W0002-T231ORG-REC-TYPE-2         VALUE ' '.
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGROLLUP02-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP03-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP04-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP05-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP06-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP07-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP08-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP09-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP10-C      PIC X(02).
               10  FILLER                     PIC X(02).
               10  W0002-F-ORGROLLUP11-C      PIC X(02).
               10  FILLER                     PIC X(02).
      *        10  W0002-F-ORGID-C            PIC X(04).
      *        10  W0002-F-ORGPRNT-C          PIC X(01).
      *        10  W0002-F-DIVAFM01-C         PIC X(04).
      *        10  W0002-F-DIVAFM02-C         PIC X(04).
      *        10  W0002-F-DIVAFM03-C         PIC X(04).
               10  W0002-F-ORGLN-X            PIC X(28).

           EJECT
       01  W0003-T231BOOK-TABLE-AREA.
           05  W0003-T231BOOK-TABLE OCCURS 500 TIMES.
               10  W0003-T231BOOK-TABLE-ENTRY  PIC X(200).

           EJECT
       01  W0004-REPORT-TABLE.
           05  W0004-REPORT-ENTRIES OCCURS 18 TIMES INDEXED BY W0004-X.
               10  W0004-REPORT-ENTRY   PIC X(04).

           EJECT
      **===========================================================**
      **   FDAT - TRANSACTION ID'S                                 **
      **===========================================================**
           COPY C231WTXN.

           EJECT
      **===========================================================**
      **   PROGRAM MAP AREA                                        **
      **===========================================================**
           COPY M231F03.

           EJECT
      **===========================================================**
      **   CICS COPYBOOKS AREA                                     **
      **===========================================================**
           COPY C108CDBA.

           EJECT
           COPY DFHAID.

           EJECT
           COPY C751CONW.

           EJECT
           COPY C231MSGS.

           EJECT
           COPY C108W900.

           EJECT
           COPY C108W998.

           EJECT
           COPY D972ERRM.

           EJECT
      **===========================================================**
      **   DATE ROUTINE.                                           **
      **===========================================================**
           COPY NSDTREC.

           EJECT
      **===========================================================**
      **   WORKING STORAGE COMMAREA                                **
      **===========================================================**
           COPY C231COMM.
               10  MAP-SAVE-AREA REDEFINES CA-MAP-SAVE-AREA.
                   15  ACTIVE-MAP-FLAG            PIC  X(01).
                       88  MAP-1-ACTIVE           VALUE '1'.
                       88  MAP-A-ACTIVE           VALUE 'A'.
                       88  MAP-B-ACTIVE           VALUE 'B'.
                       88  MAP-C-ACTIVE           VALUE 'C'.
                       88  MAP-D-ACTIVE           VALUE 'D'.

                   15  DELETE-REQUESTED-FLAG      PIC  X(01).
                       88  DELETE-REQUESTED       VALUE 'Y'.
                       88  DELETE-NOT-REQUESTED   VALUE 'N'.

                   15  INSERT-FLAG                PIC  X(01).
                       88  INSERT-SUCCESSFUL      VALUE 'Y'.
                       88  INSERT-NOT-SUCCESSFUL  VALUE 'N'.

                   15  WS-M-INDEX                 PIC S9(04) COMP.

      *--------------- MAP 1 SAVE AREA ---------------------------*

                   15  WS-M-MIN-VALUES.
                       20  WS-M-MIN-RPTGRP-C      PIC  X(03).
                       20  WS-M-MIN-ORDER-BY      PIC  X(02).

                   15  WS-M-MAX-VALUES.
                       20  WS-M-MAX-RPTGRP-C      PIC  X(03).
                       20  WS-M-MAX-ORDER-BY      PIC  X(02).

                   15  WS-MAP-DATA-VALUES  OCCURS 10 TIMES.
                       20  WS-M-F-RPTID-C         PIC  X(04).
                       20  WS-M-F-RPTGRP-C        PIC  X(03).
                       20  WS-M-F-RPTSEQ-C        PIC  X(02).
                       20  WS-M-F-RPTID-X         PIC  X(80).

      *--------------- MAP B SAVE AREA ---------------------------*

                   15  WS-M-B-MIN-VALUES.
                       20  WS-M-B-MIN-BKID-C      PIC  X(04).
                       20  WS-M-B-MIN-RPTGRP-C    PIC  X(03).
                       20  WS-M-B-MIN-SEQ-N       PIC S9(09) COMP.

                   15  WS-M-B-MAX-VALUES.
                       20  WS-M-B-MAX-BKID-C      PIC  X(04).
                       20  WS-M-B-MAX-RPTGRP-C    PIC  X(03).
                       20  WS-M-B-MAX-SEQ-N       PIC S9(09) COMP.

                   15  WS-MAP-B-DATA-VALUES  OCCURS 14 TIMES.
                       20  WS-M-B-F-BKID-C        PIC  X(04).
                       20  WS-M-B-F-RPTGRP-C      PIC  X(03).
                       20  WS-M-B-DB-RECTYP-C     PIC  X(01).
                       20  WS-M-B-A-SEQ-N         PIC S9(09) COMP.

                   15  WS-MAP-B-PRT-SEQ-VALUES.
                       20  WS-M-B-F-ORG-C         PIC  X(02).
                       20  WS-M-B-F-RGN-C         PIC  X(02).
                       20  WS-M-B-PRT-SEQ1-C      PIC  X(01).
                       20  WS-M-B-SEQ1-01-C       PIC  X(04).
                       20  WS-M-B-SEQ1-02-C       PIC  X(04).
                       20  WS-M-B-SEQ1-03-C       PIC  X(04).
                       20  WS-M-B-SEQ1-04-C       PIC  X(04).
                       20  WS-M-B-SEQ1-05-C       PIC  X(04).
                       20  WS-M-B-SEQ1-06-C       PIC  X(04).
                       20  WS-M-B-SEQ1-07-C       PIC  X(04).
                       20  WS-M-B-SEQ1-08-C       PIC  X(04).
                       20  WS-M-B-SEQ1-09-C       PIC  X(04).
                       20  WS-M-B-SEQ1-10-C       PIC  X(04).
                       20  WS-M-B-SEQ1-11-C       PIC  X(04).
                       20  WS-M-B-PRT-SEQ2-C      PIC  X(01).
                       20  WS-M-B-SEQ2-01-C       PIC  X(04).
                       20  WS-M-B-SEQ2-02-C       PIC  X(04).
                       20  WS-M-B-SEQ2-03-C       PIC  X(04).
                       20  WS-M-B-SEQ2-04-C       PIC  X(04).
                       20  WS-M-B-SEQ2-05-C       PIC  X(04).
                       20  WS-M-B-SEQ2-06-C       PIC  X(04).
                       20  WS-M-B-SEQ2-07-C       PIC  X(04).
                       20  WS-M-B-SEQ2-08-C       PIC  X(04).
                       20  WS-M-B-SEQ2-09-C       PIC  X(04).
                       20  WS-M-B-SEQ2-10-C       PIC  X(04).
                       20  WS-M-B-SEQ2-11-C       PIC  X(04).

      *--------------- MAP C SAVE AREA ---------------------------*

                   15  WS-M-C-MIN-VALUES.
                       20  WS-M-C-MIN-RPTID-C     PIC  X(04).

                   15  WS-M-C-MAX-VALUES.
                       20  WS-M-C-MAX-RPTID-C     PIC  X(04).

                   15  WS-M-C-DATA-VALUES    OCCURS 10 TIMES.
                       20  WS-M-C-F-ORG-C         PIC  X(02).
                       20  WS-M-C-F-RGN-C         PIC  X(02).
                       20  WS-M-C-PRT-SEQ1-C      PIC  X(01).

                   15  WS-MAP-C-DATA-VALUES.
                       20  WS-M-C-F-RPTGRP-C      PIC  X(03).
                       20  WS-M-C-F-RPT01-C       PIC  X(04).
                       20  WS-M-C-F-RPT02-C       PIC  X(04).
                       20  WS-M-C-F-RPT03-C       PIC  X(04).
                       20  WS-M-C-F-RPT04-C       PIC  X(04).
                       20  WS-M-C-F-RPT05-C       PIC  X(04).
                       20  WS-M-C-F-RPT06-C       PIC  X(04).
                       20  WS-M-C-F-RPT07-C       PIC  X(04).
                       20  WS-M-C-F-RPT08-C       PIC  X(04).
                       20  WS-M-C-F-RPT09-C       PIC  X(04).
                       20  WS-M-C-F-RPT10-C       PIC  X(04).
                       20  WS-M-C-F-RPT11-C       PIC  X(04).
                       20  WS-M-C-F-RPT12-C       PIC  X(04).
                       20  WS-M-C-F-RPT13-C       PIC  X(04).
                       20  WS-M-C-F-RPT14-C       PIC  X(04).
                       20  WS-M-C-F-RPT15-C       PIC  X(04).
                       20  WS-M-C-F-RPT16-C       PIC  X(04).
                       20  WS-M-C-F-RPT17-C       PIC  X(04).
                       20  WS-M-C-F-RPT18-C       PIC  X(04).

      *--------------- MAP D SAVE AREA ---------------------------*

                   15  ORG-SELECTED-FLAG          PIC  X(01).
                       88  ORG-SELECTED           VALUE 'Y'.
                       88  ORG-NOT-SELECTED       VALUE 'N'.

                   15  WS-M-D-MIN-VALUES.
                       20  WS-M-D-MIN-ORG-C       PIC  X(04).
                       20  WS-M-D-MIN-RECTYP-C    PIC  X(01).
                       20  WS-M-D-MIN-L01-C       PIC  X(03).
                       20  WS-M-D-MIN-L02-C       PIC  X(03).
                       20  WS-M-D-MIN-L03-C       PIC  X(03).
                       20  WS-M-D-MIN-L04-C       PIC  X(03).
                       20  WS-M-D-MIN-L05-C       PIC  X(03).
                       20  WS-M-D-MIN-L06-C       PIC  X(03).
                       20  WS-M-D-MIN-L07-C       PIC  X(03).
                       20  WS-M-D-MIN-L08-C       PIC  X(03).
                       20  WS-M-D-MIN-L09-C       PIC  X(03).
                       20  WS-M-D-MIN-L10-C       PIC  X(03).
                       20  WS-M-D-MIN-L11-C       PIC  X(03).
                       20  WS-M-D-MIN-ORGID-C     PIC  X(04).
                       20  WS-M-D-MIN-SEQ-N       PIC S9(09) COMP.

                   15  WS-M-D-MAX-VALUES.
                       20  WS-M-D-MAX-ORG-C       PIC  X(04).
                       20  WS-M-D-MAX-RECTYP-C    PIC  X(01).
                       20  WS-M-D-MAX-L01-C       PIC  X(03).
                       20  WS-M-D-MAX-L02-C       PIC  X(03).
                       20  WS-M-D-MAX-L03-C       PIC  X(03).
                       20  WS-M-D-MAX-L04-C       PIC  X(03).
                       20  WS-M-D-MAX-L05-C       PIC  X(03).
                       20  WS-M-D-MAX-L06-C       PIC  X(03).
                       20  WS-M-D-MAX-L07-C       PIC  X(03).
                       20  WS-M-D-MAX-L08-C       PIC  X(03).
                       20  WS-M-D-MAX-L09-C       PIC  X(03).
                       20  WS-M-D-MAX-L10-C       PIC  X(03).
                       20  WS-M-D-MAX-L11-C       PIC  X(03).
                       20  WS-M-D-MAX-ORGID-C     PIC  X(04).
                       20  WS-M-D-MAX-SEQ-N       PIC S9(09) COMP.

                   15  WS-M-D-SELECTED-VALUES.
                       20  WS-M-D-SEL-ORG-C       PIC  X(04).
                       20  WS-M-D-SEL-RECTYP-C    PIC  X(01).
                       20  WS-M-D-SEL-L01-C       PIC  X(03).
                       20  WS-M-D-SEL-L02-C       PIC  X(03).
                       20  WS-M-D-SEL-L03-C       PIC  X(03).
                       20  WS-M-D-SEL-L04-C       PIC  X(03).
                       20  WS-M-D-SEL-L05-C       PIC  X(03).
                       20  WS-M-D-SEL-L06-C       PIC  X(03).
                       20  WS-M-D-SEL-L07-C       PIC  X(03).
                       20  WS-M-D-SEL-L08-C       PIC  X(03).
                       20  WS-M-D-SEL-L09-C       PIC  X(03).
                       20  WS-M-D-SEL-L10-C       PIC  X(03).
                       20  WS-M-D-SEL-L11-C       PIC  X(03).
                       20  WS-M-D-SEL-ORGID-C     PIC  X(04).
                       20  WS-M-D-SEL-SEQ-N       PIC S9(09) COMP.

                   15  WS-M-D-DATA-VALUES    OCCURS 13 TIMES.
                       20  WS-M-D-F-ORG-C         PIC  X(04).
                       20  WS-M-D-F-L01-C         PIC  X(03).
                       20  WS-M-D-F-L02-C         PIC  X(03).
                       20  WS-M-D-F-L03-C         PIC  X(03).
                       20  WS-M-D-F-L04-C         PIC  X(03).
                       20  WS-M-D-F-L05-C         PIC  X(03).
                       20  WS-M-D-F-L06-C         PIC  X(03).
                       20  WS-M-D-F-L07-C         PIC  X(03).
                       20  WS-M-D-F-L08-C         PIC  X(03).
                       20  WS-M-D-F-L09-C         PIC  X(03).
                       20  WS-M-D-F-L10-C         PIC  X(03).
                       20  WS-M-D-F-L11-C         PIC  X(03).

           EJECT
      **===========================================================**
      **   DB2 INCLUDES                                            **
      **===========================================================**
           EXEC SQL
                INCLUDE SQLCA
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ACS
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231SEC
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DIST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231BOOK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RPT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231LINE
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231COL
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORG
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RGN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231PRIM
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORGF
           END-EXEC.

           EJECT
      **===========================================================**
      **   DB2 CURSORS                                             **
      **===========================================================**

      **===========================================================**
      **   CSR_1 IS THE FORWARD SCROLLING CURSOR FOR ALL REPORTS   **
      **   WITHIN A BOOK ID.  (I KNOW THIS LOOKS COMPLICATED, BUT  **
      **   THE STATEMENT SIMPLY TAKES THE 18 POSSIBLE REPORTS ON   **
      **   EACH TYPE THREE RECORD AND PUTS THEM INTO A SEQUENTIAL  **
      **   LIST FOR PROCESSING.  THIS IS SOMETHING THAT WE WILL    **
      **   FIX LATER WITH A BETTER DATABASE DESGIN.)               **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_1 CURSOR FOR
                 SELECT '01'
                      , F_RPTGRP_C
                      , F_RPT01_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT01_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '01'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '02'
                      , F_RPTGRP_C
                      , F_RPT02_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT02_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '02'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '03'
                      , F_RPTGRP_C
                      , F_RPT03_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT03_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '03'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '04'
                      , F_RPTGRP_C
                      , F_RPT04_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT04_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '04'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '05'
                      , F_RPTGRP_C
                      , F_RPT05_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT05_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '05'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '06'
                      , F_RPTGRP_C
                      , F_RPT06_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT06_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '06'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '07'
                      , F_RPTGRP_C
                      , F_RPT07_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT07_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '07'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '08'
                      , F_RPTGRP_C
                      , F_RPT08_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT08_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '08'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '09'
                      , F_RPTGRP_C
                      , F_RPT09_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT09_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '09'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '10'
                      , F_RPTGRP_C
                      , F_RPT10_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT10_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '10'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '11'
                      , F_RPTGRP_C
                      , F_RPT11_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT11_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '11'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '12'
                      , F_RPTGRP_C
                      , F_RPT12_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT12_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '12'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '13'
                      , F_RPTGRP_C
                      , F_RPT13_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT13_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '13'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '14'
                      , F_RPTGRP_C
                      , F_RPT14_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT14_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '14'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '15'
                      , F_RPTGRP_C
                      , F_RPT15_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT15_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '15'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '16'
                      , F_RPTGRP_C
                      , F_RPT16_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT16_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '16'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '17'
                      , F_RPTGRP_C
                      , F_RPT17_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT17_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '17'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '18'
                      , F_RPTGRP_C
                      , F_RPT18_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT18_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '18'       >= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  > :DCLT231BOOK.F-RPTGRP-C))
                  ORDER BY
                        2
                      , 1
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_2 IS THE BACKWARD SCROLLING CURSOR FOR ALL REPORTS  **
      **   WITHIN A BOOK ID.  (THIS IS JUST AS UGLY AS CSR_1).     **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_2 CURSOR FOR
                 SELECT '01'
                      , F_RPTGRP_C
                      , F_RPT01_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT01_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '01'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '02'
                      , F_RPTGRP_C
                      , F_RPT02_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT02_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '02'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '03'
                      , F_RPTGRP_C
                      , F_RPT03_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT03_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '03'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '04'
                      , F_RPTGRP_C
                      , F_RPT04_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT04_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '04'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '05'
                      , F_RPTGRP_C
                      , F_RPT05_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT05_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '05'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '06'
                      , F_RPTGRP_C
                      , F_RPT06_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT06_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '06'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '07'
                      , F_RPTGRP_C
                      , F_RPT07_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT07_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '07'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '08'
                      , F_RPTGRP_C
                      , F_RPT08_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT08_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '08'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '09'
                      , F_RPTGRP_C
                      , F_RPT09_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT09_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '09'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '10'
                      , F_RPTGRP_C
                      , F_RPT10_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT10_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '10'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '11'
                      , F_RPTGRP_C
                      , F_RPT11_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT11_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '11'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '12'
                      , F_RPTGRP_C
                      , F_RPT12_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT12_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '12'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '13'
                      , F_RPTGRP_C
                      , F_RPT13_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT13_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '13'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '14'
                      , F_RPTGRP_C
                      , F_RPT14_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT14_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '14'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '15'
                      , F_RPTGRP_C
                      , F_RPT15_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT15_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '15'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '16'
                      , F_RPTGRP_C
                      , F_RPT16_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT16_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '16'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '17'
                      , F_RPTGRP_C
                      , F_RPT17_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT17_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '17'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                 UNION
                 SELECT '18'
                      , F_RPTGRP_C
                      , F_RPT18_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND DB_RECTYP_C   = '3'
                    AND F_RPT18_C     > '    '
                    AND ((F_RPTGRP_C  = :DCLT231BOOK.F-RPTGRP-C
                      AND '18'       <= :W0001-ORDER-BY)
                      OR (F_RPTGRP_C  < :DCLT231BOOK.F-RPTGRP-C))
                  ORDER BY
                        2 DESC
                      , 1 DESC
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_3 IS THE RPT ID SCREEN CURSOR.                      **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_3 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                    AND DB_RECTYP_C   IN ('/','2','3')
                  ORDER BY
                        F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_4 IS THE PRT LVLS SCREEN FORWARD CURSOR.            **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_4 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                    AND DB_RECTYP_C   IN ('4','5','6')
                    AND A_SEQ_N       > :DCLT231BOOK.A-SEQ-N
                  ORDER BY
                        F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_5 IS THE PRT LVLS SCREEN BACKWARD CURSOR.           **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_5 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                    AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                    AND DB_RECTYP_C   IN ('4','5','6')
                    AND A_SEQ_N       < :DCLT231BOOK.A-SEQ-N
                  ORDER BY
                        F_BKID_C    DESC
                      , F_RPTGRP_C  DESC
                      , A_SEQ_N     DESC
           END-EXEC.

           EJECT
      **===========================================================**
      **   CURSOR CSR_6 IS THE REPORT SELECTION LIST FORWARD CSR.  **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_6 CURSOR FOR
                 SELECT A.F_RPTID_C
                      , A.F_RPTID_X
                      , A.F_ORG_C
                      , A.F_RGN_C
                      , B.F_PRNT_C
                   FROM D231.T231RPT A
                      , D231.T231RPT B
                  WHERE A.F_RPTID_C    = B.F_RPTID_C
                    AND A.DB_RECTYP_C  = '1'
                    AND B.DB_RECTYP_C  = '2'
                    AND A.F_STDRPT_C   = 'Y'
                    AND A.F_RPTID_C   >= :DCLT231RPT.F-RPTID-C
                  ORDER BY
                        F_RPTID_C
           END-EXEC.

           EJECT
      **===========================================================**
      **   CURSOR CSR_7 IS THE REPORT SELECTION LIST BACKWARD CSR. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_7 CURSOR FOR
                 SELECT A.F_RPTID_C
                      , A.F_RPTID_X
                      , A.F_ORG_C
                      , A.F_RGN_C
                      , B.F_PRNT_C
                   FROM D231.T231RPT A
                      , D231.T231RPT B
                  WHERE A.F_RPTID_C    = B.F_RPTID_C
                    AND A.DB_RECTYP_C  = '1'
                    AND B.DB_RECTYP_C  = '2'
                    AND A.F_STDRPT_C   = 'Y'
                    AND A.F_RPTID_C   <= :DCLT231RPT.F-RPTID-C
                  ORDER BY
                        F_RPTID_C DESC
           END-EXEC.
           EJECT
      **===========================================================**
      **   CSR_8 IS THE COPY CURSOR.                               **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_8 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C        = :DCLT231BOOK.F-BKID-C
                    AND F_RPTGRP_C      = :DCLT231BOOK.F-RPTGRP-C
                  ORDER BY
                        F_RPTGRP_C
                      , A_SEQ_N
           END-EXEC.
           EJECT
      **===========================================================**
      **   CSR_9 IS THE CURSOR FOR INCREMENTING THE SEQUENCE NBRS. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_9 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C        = :DCLT231BOOK.F-BKID-C
                    AND F_RPTGRP_C      = :DCLT231BOOK.F-RPTGRP-C
                    AND DB_RECTYP_C    IN ('4','5','6')
                    AND A_SEQ_N         > :DCLT231BOOK.A-SEQ-N
                  ORDER BY
                        A_SEQ_N DESC
           END-EXEC.


           EJECT
      **===========================================================**
      **   CSR_10 IS THE FORWARD SCROLLING CURSOR FOR THE ORG TBL. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_10 CURSOR FOR
                 SELECT F_ORG_C
                      , DB_RECTYP_C
                      , F_ORGLVL01_C
                      , F_ORGLVL02_C
                      , F_ORGLVL03_C
                      , F_ORGLVL04_C
                      , F_ORGLVL05_C
                      , F_ORGLVL06_C
                      , F_ORGLVL07_C
                      , F_ORGLVL08_C
                      , F_ORGLVL09_C
                      , F_ORGLVL10_C
                      , F_ORGLVL11_C
                      , A_SEQ_N
                      , F_CMNT_I
                      , F_DFLTAFM_C
                      , F_ORGID_C
                      , F_PRNT_C
                      , F_DIVAFM01_C
                      , F_DIVAFM02_C
                      , F_DIVAFM03_C
                      , F_ORG_X
                   FROM D231.T231ORGF A
                  WHERE A_SEQ_N     >= :DCLT231ORGF.A-SEQ-N
                    AND DB_RECTYP_C  = '2'
                    AND F_ORG_C      = :DCLT231ORGF.F-ORG-C
                    AND EXISTS
                      ( SELECT *
                          FROM D231.T231SEC B
                         WHERE B.A_UID_C     = :DCLT231SEC.A-UID-C
                           AND B.DB_RECTYP_C = 'P'
                           AND ( B.F_AFM_C   = A.F_ORGLVL02_C
                              OR B.F_AFM_C   = A.F_ORGLVL03_C
                              OR B.F_AFM_C   = A.F_ORGLVL04_C
                              OR B.F_AFM_C   = A.F_ORGLVL05_C
                              OR B.F_AFM_C   = 'NS')
                       )
                  ORDER BY
                        A_SEQ_N
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_11 IS THE BACKWARD SCROLLING CURSOR FOR THE ORG TBL. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_11 CURSOR FOR
                 SELECT F_ORG_C
                      , DB_RECTYP_C
                      , F_ORGLVL01_C
                      , F_ORGLVL02_C
                      , F_ORGLVL03_C
                      , F_ORGLVL04_C
                      , F_ORGLVL05_C
                      , F_ORGLVL06_C
                      , F_ORGLVL07_C
                      , F_ORGLVL08_C
                      , F_ORGLVL09_C
                      , F_ORGLVL10_C
                      , F_ORGLVL11_C
                      , A_SEQ_N
                      , F_CMNT_I
                      , F_DFLTAFM_C
                      , F_ORGID_C
                      , F_PRNT_C
                      , F_DIVAFM01_C
                      , F_DIVAFM02_C
                      , F_DIVAFM03_C
                      , F_ORG_X
                   FROM D231.T231ORGF A
                  WHERE A_SEQ_N     <= :DCLT231ORGF.A-SEQ-N
                    AND DB_RECTYP_C  = '2'
                    AND F_ORG_C      = :DCLT231ORGF.F-ORG-C
                    AND EXISTS
                      ( SELECT *
                          FROM D231.T231SEC B
                         WHERE B.A_UID_C     = :DCLT231SEC.A-UID-C
                           AND B.DB_RECTYP_C = 'P'
                           AND ( B.F_AFM_C   = A.F_ORGLVL02_C
                              OR B.F_AFM_C   = A.F_ORGLVL03_C
                              OR B.F_AFM_C   = A.F_ORGLVL04_C
                              OR B.F_AFM_C   = A.F_ORGLVL05_C
                              OR B.F_AFM_C   = 'NS')
                       )
                  ORDER BY
                        A_SEQ_N  DESC
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_12 IS THE ORG TBL SEARCH CURSOR.                    **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_12 CURSOR FOR
                 SELECT F_ORG_C
                      , DB_RECTYP_C
                      , A_SEQ_N
                   FROM D231.T231ORGF
                  WHERE (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                     AND F_ORGLVL08_C  = :DCLT231ORGF.F-ORGLVL08-C
                     AND F_ORGLVL09_C  = :DCLT231ORGF.F-ORGLVL09-C
                     AND F_ORGLVL10_C  = :DCLT231ORGF.F-ORGLVL10-C
                     AND F_ORGLVL11_C  = :DCLT231ORGF.F-ORGLVL11-C
                     AND A_SEQ_N       > :DCLT231ORGF.A-SEQ-N)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                     AND F_ORGLVL08_C  = :DCLT231ORGF.F-ORGLVL08-C
                     AND F_ORGLVL09_C  = :DCLT231ORGF.F-ORGLVL09-C
                     AND F_ORGLVL10_C  = :DCLT231ORGF.F-ORGLVL10-C
                     AND F_ORGLVL11_C  > :DCLT231ORGF.F-ORGLVL11-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                     AND F_ORGLVL08_C  = :DCLT231ORGF.F-ORGLVL08-C
                     AND F_ORGLVL09_C  = :DCLT231ORGF.F-ORGLVL09-C
                     AND F_ORGLVL10_C  > :DCLT231ORGF.F-ORGLVL10-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                     AND F_ORGLVL08_C  = :DCLT231ORGF.F-ORGLVL08-C
                     AND F_ORGLVL09_C  > :DCLT231ORGF.F-ORGLVL09-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                     AND F_ORGLVL08_C  > :DCLT231ORGF.F-ORGLVL08-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                     AND F_ORGLVL07_C  > :DCLT231ORGF.F-ORGLVL07-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                     AND F_ORGLVL06_C  > :DCLT231ORGF.F-ORGLVL06-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                     AND F_ORGLVL05_C  > :DCLT231ORGF.F-ORGLVL05-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                     AND F_ORGLVL04_C  > :DCLT231ORGF.F-ORGLVL04-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                     AND F_ORGLVL03_C  > :DCLT231ORGF.F-ORGLVL03-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                     AND F_ORGLVL02_C  > :DCLT231ORGF.F-ORGLVL02-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   = :DCLT231ORGF.DB-RECTYP-C
                     AND F_ORGLVL01_C  > :DCLT231ORGF.F-ORGLVL01-C)

                     OR (F_ORG_C       = :DCLT231ORGF.F-ORG-C
                     AND DB_RECTYP_C   > :DCLT231ORGF.DB-RECTYP-C)

                     OR (F_ORG_C       > :DCLT231ORGF.F-ORG-C)
                  ORDER BY
                        A_SEQ_N
           END-EXEC.


      **===========================================================**
      **   END OF WORKING STORAGE SECTION                          **
      **===========================================================**
           EJECT
       LINKAGE SECTION.

       01  DFHCOMMAREA.
           05  FILLER                   PICTURE X(4096).

           EJECT
       PROCEDURE DIVISION.

           EXEC CICS HANDLE ABEND
                LABEL    (Z900-HANDLE-ERROR)
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR    (Z900-HANDLE-ERROR)
                ILLOGIC  (Z900-HANDLE-ERROR)
                DSIDERR  (Z900-HANDLE-ERROR)
                INVREQ   (Z900-HANDLE-ERROR)
                IOERR    (Z900-HANDLE-ERROR)
                ISCINVREQ(Z900-HANDLE-ERROR)
                NOSPACE  (Z900-HANDLE-ERROR)
           END-EXEC.

       A000-MAINLINE.

           MOVE 'A000'      TO CA-PARAGRAPH-NBR.

           PERFORM A100-INITIALIZATION.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A300-ACCEPT-SCREEN

               EVALUATE TRUE
                   WHEN MAP-1-ACTIVE
                        PERFORM A001-PROCESS-MAP-1
                   WHEN MAP-A-ACTIVE
                        PERFORM A002-PROCESS-MAP-A
                   WHEN MAP-B-ACTIVE
                        PERFORM A003-PROCESS-MAP-B
                   WHEN MAP-C-ACTIVE
                        PERFORM A004-PROCESS-MAP-C
                   WHEN MAP-D-ACTIVE
                        PERFORM A005-PROCESS-MAP-D
               END-EVALUATE
           END-IF.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       A001-PROCESS-MAP-1.

           MOVE 'A001'      TO CA-PARAGRAPH-NBR.

           SET INSERT-NOT-SUCCESSFUL    TO TRUE.

           IF  EIBAID NOT EQUAL DFHPF10
               SET DELETE-NOT-REQUESTED TO TRUE
           END-IF.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM B000-PROCESS-ENTER-KEY
                    IF  W0001-LINES-SELECTED
                        MOVE RPT-UPD-TXN-ID   TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                    END-IF
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    MOVE DIST-MENU-TXN-ID     TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN EIBAID = DFHPF5
                    PERFORM E000-PROCESS-RPT-CURSOR
               WHEN EIBAID = DFHPF6
                    MOVE ZEROES TO WS-M-B-MAX-SEQ-N
                    PERFORM K000-PROCESS-PRT-SEQ-CURSOR
               WHEN EIBAID = DFHPF7
                    PERFORM D000-PROCESS-PREV-PAGE
                    IF  M-RPTID-CI (1) EQUAL SPACES
                        INITIALIZE WS-M-MAX-VALUES
                        SET NO-ERRORS  TO TRUE
                        PERFORM C000-PROCESS-NEXT-PAGE
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM C000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF10
                    PERFORM I000-DELETE-REPORT-GROUP
                    IF  NO-ERRORS
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-014 TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF11
                    PERFORM H000-COPY-TO-NEW-GROUP
                    IF  NO-ERRORS
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-020 TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF12
                    MOVE BOOK-MENU-TXN-ID TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN OTHER
                    MOVE -1             TO M-GRPKEY-CL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22I
           END-EVALUATE.

           EJECT
       A002-PROCESS-MAP-A.

           MOVE 'A002'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM J100-VALIDATE-SCREEN-FIELDS
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN EIBAID = DFHPF5
                    PERFORM J000-UPDATE-REPORT-GROUP
               WHEN EIBAID = DFHPF9
                    SET MAP-C-ACTIVE    TO TRUE
                    INITIALIZE WS-M-C-MAX-VALUES
                    PERFORM F000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN OTHER
                    MOVE -1             TO M-PRNT-CAL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22AI
           END-EVALUATE.

           EJECT
       A003-PROCESS-MAP-B.

           MOVE 'A003'      TO CA-PARAGRAPH-NBR.

           IF  EIBAID NOT EQUAL DFHPF10
               SET DELETE-NOT-REQUESTED TO TRUE
           END-IF.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM L100-VALIDATE-FIELDS
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF2
                    INITIALIZE WS-M-D-MAX-VALUES
                    SET MAP-D-ACTIVE    TO TRUE
                    PERFORM M300-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  IN ERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN EIBAID = DFHPF4
                    PERFORM N000-ADD-PRT-LVLS
               WHEN EIBAID = DFHPF5
                    PERFORM L000-UPDATE-PRT-SEQ
               WHEN EIBAID = DFHPF6
                    PERFORM N000-ADD-PRT-LVLS
               WHEN EIBAID = DFHPF7
                    PERFORM K200-PROCESS-PRT-SEQ-CURSOR
                    IF  M-TYPE-CBI(1) EQUAL SPACES
                        INITIALIZE WS-M-B-MAX-VALUES
                        SET NO-ERRORS  TO TRUE
                        PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM K100-PROCESS-PRT-SEQ-CURSOR
               WHEN EIBAID = DFHPF9
                    PERFORM N000-ADD-PRT-LVLS
               WHEN EIBAID = DFHPF10
                    PERFORM K500-DELETE-PRT-SEQ-LINE
                    IF  NO-ERRORS
                        MOVE WS-M-B-MIN-VALUES
                          TO WS-M-B-MAX-VALUES
                        SUBTRACT +1 FROM WS-M-B-MAX-SEQ-N
                        PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                        MOVE W9999-MSG-014 TO M-MSG-22BI
                    END-IF
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN OTHER
                    MOVE -1             TO M-ACT-CBL(1)
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22BI
           END-EVALUATE.

           EJECT
       A004-PROCESS-MAP-C.

           MOVE 'A004'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM F100-VALIDATE-FIELDS
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    INITIALIZE M231F3AI
                    MOVE M-BKID-CCI
                      TO M-BKID-CAI
                    MOVE WS-M-C-F-RPTGRP-C
                      TO M-RPTGRP-CAI
                    PERFORM E100-PROCESS-RPT-CURSOR
                    SET MAP-A-ACTIVE    TO TRUE
                    MOVE W9999-MSG-019  TO M-MSG-22AI
                    MOVE -1             TO M-PRNT-CAL
               WHEN EIBAID = DFHPF5
                    PERFORM F600-CHECK-FOR-SELECTION
               WHEN EIBAID = DFHPF7
                    PERFORM G000-PROCESS-PREV-PAGE
                    IF  M-RPTID-CCI (1) EQUAL SPACES
                        INITIALIZE WS-M-MAX-VALUES
                        SET NO-ERRORS  TO TRUE
                        PERFORM F000-PROCESS-NEXT-PAGE
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM F000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF12
                    INITIALIZE M231F3AI
                    MOVE M-BKID-CCI
                      TO M-BKID-CAI
                    MOVE WS-M-C-F-RPTGRP-C
                      TO M-RPTGRP-CAI
                    PERFORM E100-PROCESS-RPT-CURSOR
                    SET MAP-A-ACTIVE    TO TRUE
                    MOVE W9999-MSG-019  TO M-MSG-22AI
                    MOVE -1             TO M-PRNT-CAL
               WHEN OTHER
                    MOVE -1             TO M-RPTKEY-CCL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22CI
           END-EVALUATE.

           EJECT
       A005-PROCESS-MAP-D.

           MOVE 'A005'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM M000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    INITIALIZE M231F3BI
                    MOVE WS-M-B-MAX-BKID-C   TO M-BKID-CBI
                    MOVE WS-M-B-MAX-RPTGRP-C TO M-RPTGRP-CBI
                    MOVE ZEROES              TO WS-M-B-MAX-SEQ-N
                    PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                    SET MAP-B-ACTIVE    TO TRUE
                    MOVE W9999-MSG-019  TO M-MSG-22BI
                    MOVE -1             TO M-ACT-CBL(1)
               WHEN EIBAID = DFHPF5
                    PERFORM M200-CHECK-FOR-SELECTION
                    IF  ORG-SELECTED
                        MOVE W9999-MSG-064  TO M-MSG-22DI
                        SET ERRORS          TO TRUE
      *BWM*             MOVE -1             TO M-ORG-CL
                        MOVE -1             TO M-L01-CL
                    ELSE
                        MOVE W9999-MSG-001  TO M-MSG-22DI
                        SET ERRORS          TO TRUE
      *BWM*             MOVE -1             TO M-ORG-CL
                        MOVE -1             TO M-L01-CL
                    END-IF
               WHEN EIBAID = DFHPF7
                    PERFORM M500-PROCESS-PREV-PAGE
                    IF  M-DATA-XI (1) EQUAL SPACES
                        INITIALIZE WS-M-D-MAX-VALUES
                        SET NO-ERRORS  TO TRUE
                        PERFORM M300-PROCESS-NEXT-PAGE
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM M300-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF12
                    INITIALIZE M231F3BI
                    MOVE WS-M-B-MAX-BKID-C   TO M-BKID-CBI
                    MOVE WS-M-B-MAX-RPTGRP-C TO M-RPTGRP-CBI
                    MOVE ZEROES              TO WS-M-B-MAX-SEQ-N
                    PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                    SET MAP-B-ACTIVE    TO TRUE
                    MOVE W9999-MSG-019  TO M-MSG-22BI
                    MOVE -1             TO M-ACT-CBL(1)
               WHEN OTHER
      *BWM*         MOVE -1             TO M-ORG-CL
                    MOVE -1             TO M-L01-CL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22DI
           END-EVALUATE.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100'      TO CA-PARAGRAPH-NBR.

           IF  EIBCALEN NOT EQUAL ZEROES
               MOVE DFHCOMMAREA TO WS-COMMAREA
               IF  CA-CURRENT-PGM = PROGRAM-NAME
                   CONTINUE
               ELSE
                   MOVE CA-CURRENT-PGM TO CA-PREV-PGM
                   MOVE CA-CURRENT-TXN TO CA-PREV-TXN
                   PERFORM A150-SETUP-COMMAREA
               END-IF
           ELSE
               MOVE MAIN-MENU-TXN-ID  TO W0001-TXN-ID
               PERFORM Y600-START-TRANSACTION
           END-IF.

           EJECT
       A150-SETUP-COMMAREA.

           MOVE 'A150'      TO CA-PARAGRAPH-NBR.

           EXEC CICS ASKTIME
                ABSTIME (W0001-ABSTIME)
           END-EXEC.

           EXEC CICS FORMATTIME
                ABSTIME (W0001-ABSTIME)
                TIME    (W0001-HHCMMCSS)
                TIMESEP
                MMDDYY  (W0001-MMSDDSYY)
                DATESEP
                YEAR    (W0001-YYYY)
           END-EXEC.

           MOVE W0001-MMSDDSYY    TO M-DATEI
                                     CA-DATE.
           MOVE W0001-HHCMMCSS    TO M-TIMEI
                                     CA-TIME.

           EJECT
       A200-DISPLAY-SCREEN.

           MOVE 'A200'      TO CA-PARAGRAPH-NBR.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A210-SAVE-MAP
           ELSE
               INITIALIZE  MAP-SAVE-AREA
               INITIALIZE  M231F03I
               INITIALIZE  M231F3AI
               INITIALIZE  M231F3BI
               INITIALIZE  M231F3CI
               INITIALIZE  M231F3DI
               MOVE -1     TO M-GRPKEY-CL
               INITIALIZE  WS-M-MAX-VALUES
               SET MAP-1-ACTIVE    TO TRUE
               MOVE MAP-NAME-1     TO MAP-NAME
               PERFORM C000-PROCESS-NEXT-PAGE
           END-IF.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    PERFORM A220-SET-SCREEN-1-ATTRIBUTES
                    MOVE MAP-NAME-1 TO MAP-NAME
                    MOVE M231F03I   TO MAP-DATA
               WHEN MAP-A-ACTIVE
                    PERFORM A221-SET-SCREEN-A-ATTRIBUTES
                    MOVE MAP-NAME-A TO MAP-NAME
                    MOVE M231F3AI   TO MAP-DATA
               WHEN MAP-B-ACTIVE
                    PERFORM A222-SET-SCREEN-B-ATTRIBUTES
                    MOVE MAP-NAME-B TO MAP-NAME
                    MOVE M231F3BI   TO MAP-DATA
               WHEN MAP-C-ACTIVE
                    PERFORM A223-SET-SCREEN-C-ATTRIBUTES
                    MOVE MAP-NAME-C TO MAP-NAME
                    MOVE M231F3CI   TO MAP-DATA
               WHEN MAP-D-ACTIVE
                    PERFORM A224-SET-SCREEN-D-ATTRIBUTES
                    MOVE MAP-NAME-D TO MAP-NAME
                    MOVE M231F3DI   TO MAP-DATA
           END-EVALUATE.

           EXEC CICS HANDLE CONDITION
                MAPFAIL (Z100-MAPFAIL)
                ERROR   (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS SEND
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                FROM   (MAP-DATA)
                ERASE
                CURSOR
           END-EXEC.

           EJECT
       A210-SAVE-MAP.

           MOVE 'A210'      TO CA-PARAGRAPH-NBR.

           EJECT
       A220-SET-SCREEN-1-ATTRIBUTES.

           MOVE 'A220'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CA
                M-FYPDA
                M-DATEA
                M-TIMEA
                M-MSG-22A.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-DSID-CA
                M-DSID-NA
                M-DSID-XA
                M-BKID-CA
                M-BKID-XA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-GRPKEY-CA.
      *BWM*     M-RPTKEY-CA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CA        (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-RPT-NA        (W0001-X)
                    M-SEQ-NA        (W0001-X)
                    M-RPTID-CA      (W0001-X)
                    M-RPTID-XA      (W0001-X)

               IF  M-RPT-NI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CI (W0001-X)
               ELSE
                   MOVE M-ACT-CI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA TO M-ACT-CI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-GRPKEY-CI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-GRPKEY-CI.

      *BWM*MOVE M-RPTKEY-CI    TO W9998-DATA.
      *BWM*PERFORM Z998-MOVE-UNDERSCORES.
      *BWM*MOVE W9998-DATA     TO M-RPTKEY-CI.

           MOVE CA-CURR-F-DSID-C  TO M-DSID-CI.
           MOVE CA-CURR-F-DSID-N  TO M-DSID-NI.
           MOVE CA-CURR-F-DSLN-X  TO M-DSID-XI.

           MOVE CA-CURR-F-BKID-C  TO M-BKID-CI.
           MOVE CA-CURR-F-BKID-X  TO M-BKID-XI.

           MOVE CA-OP-ID       TO M-UID-CI.
           MOVE CA-FYPD        TO M-FYPDI.
           MOVE CA-DATE        TO M-DATEI.
           MOVE CA-TIME        TO M-TIMEI.

           EJECT
       A221-SET-SCREEN-A-ATTRIBUTES.

           MOVE 'A221'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CAA
                M-FYPDAA
                M-DATEAA
                M-TIMEAA
                M-MSG-22AA.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-BKID-CAA
                M-RPTGRP-CAA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-PRNT-CAA
                M-CMNT-XAA
                M-RPT01-CCA
                M-RPT02-CCA
                M-RPT03-CCA
                M-RPT04-CCA
                M-RPT05-CCA
                M-RPT06-CCA
                M-RPT07-CCA
                M-RPT08-CCA
                M-RPT09-CCA
                M-RPT10-CCA
                M-RPT11-CCA
                M-RPT12-CCA
                M-RPT13-CCA
                M-RPT14-CCA
                M-RPT15-CCA
                M-RPT16-CCA
                M-RPT17-CCA
                M-RPT18-CCA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-PGCNT-NAA     (W0001-X)
                    M-TOC-XAA       (W0001-X)

               MOVE M-PGCNT-NAI (W0001-X) TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA TO M-PGCNT-NAI (W0001-X)

               MOVE M-TOC-XAI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA TO M-TOC-XAI (W0001-X)
           END-PERFORM.

           MOVE M-PRNT-CAI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-PRNT-CAI.

           MOVE M-CMNT-XAI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-CMNT-XAI.

           MOVE M-RPT01-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT01-CCI.

           MOVE M-RPT02-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT02-CCI.

           MOVE M-RPT03-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT03-CCI.

           MOVE M-RPT04-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT04-CCI.

           MOVE M-RPT05-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT05-CCI.

           MOVE M-RPT06-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT06-CCI.

           MOVE M-RPT07-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT07-CCI.

           MOVE M-RPT08-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT08-CCI.

           MOVE M-RPT09-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT09-CCI.

           MOVE M-RPT10-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT10-CCI.

           MOVE M-RPT11-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT11-CCI.

           MOVE M-RPT12-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT12-CCI.

           MOVE M-RPT13-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT13-CCI.

           MOVE M-RPT14-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT14-CCI.

           MOVE M-RPT15-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT15-CCI.

           MOVE M-RPT16-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT16-CCI.

           MOVE M-RPT17-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT17-CCI.

           MOVE M-RPT18-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPT18-CCI.

           MOVE CA-OP-ID       TO M-UID-CAI.
           MOVE CA-FYPD        TO M-FYPDAI.
           MOVE CA-DATE        TO M-DATEAI.
           MOVE CA-TIME        TO M-TIMEAI.

           EJECT
       A222-SET-SCREEN-B-ATTRIBUTES.

           MOVE 'A22S'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CBA
                M-FYPDBA
                M-DATEBA
                M-TIMEBA
                M-MSG-22BA.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-BKID-CBA
                M-RPTGRP-CBA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CBA       (W0001-X)
               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-TYPE-CBA      (W0001-X)

               IF  M-TYPE-CBI (W0001-X) EQUAL SPACES
               OR (W0001-X = 2 OR 4 OR 6 OR 8 OR 10 OR 12 OR 14)
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CBA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CBI (W0001-X)
               ELSE
                   MOVE M-ACT-CBI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA TO M-ACT-CBI (W0001-X)
               END-IF

               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > 11

                   IF  M-TYPE-CBI (W0001-X) EQUAL SPACES
                       MOVE ATTR-ALPHA-PROT-MDT
                         TO M-PRTLVL-CBA (W0001-X , W0001-IX)

                       MOVE SPACES
                         TO M-PRTLVL-CBI (W0001-X , W0001-IX)
                   ELSE
                       MOVE ATTR-ALPHA-UNPROT-MDT
                         TO M-PRTLVL-CBA (W0001-X , W0001-IX)

                       MOVE M-PRTLVL-CBI (W0001-X , W0001-IX)
                         TO W9998-DATA
                       PERFORM Z998-MOVE-UNDERSCORES
                       MOVE W9998-DATA
                         TO M-PRTLVL-CBI (W0001-X , W0001-IX)
                   END-IF
               END-PERFORM
           END-PERFORM.

           MOVE CA-OP-ID       TO M-UID-CBI.
           MOVE CA-FYPD        TO M-FYPDBI.
           MOVE CA-DATE        TO M-DATEBI.
           MOVE CA-TIME        TO M-TIMEBI.

           EJECT
       A223-SET-SCREEN-C-ATTRIBUTES.

           MOVE 'A223'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CCA
                M-FYPDCA
                M-DATECA
                M-TIMECA
                M-MSG-22CA.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-DSID-CCA
                M-DSID-NCA
                M-DSID-XCA
                M-BKID-CCA
                M-BKID-XCA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-RPTKEY-CCA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-C-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CCA        (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-RPTID-CCA      (W0001-X)
                    M-RPTID-XCA      (W0001-X)

               IF  M-RPTID-CCI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CCA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CCI    (W0001-X)
               ELSE
                   MOVE M-ACT-CCI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA         TO M-ACT-CCI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-RPTKEY-CCI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPTKEY-CCI.

           MOVE CA-CURR-F-DSID-C  TO M-DSID-CCI.
           MOVE CA-CURR-F-DSID-N  TO M-DSID-NCI.
           MOVE CA-CURR-F-DSLN-X  TO M-DSID-XCI.

           MOVE CA-CURR-F-BKID-C  TO M-BKID-CCI.
           MOVE CA-CURR-F-BKID-X  TO M-BKID-XCI.

           MOVE CA-OP-ID       TO M-UID-CCI.
           MOVE CA-FYPD        TO M-FYPDCI.
           MOVE CA-DATE        TO M-DATECI.
           MOVE CA-TIME        TO M-TIMECI.

           EJECT
       A224-SET-SCREEN-D-ATTRIBUTES.

           MOVE 'A224'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CDA
                M-FYPDDA
                M-DATEDA
                M-TIMEDA
                M-MSG-22DA.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-ORG-CA
           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-L01-CA
                M-L02-CA
                M-L03-CA
                M-L04-CA
                M-L05-CA
                M-L06-CA
                M-L07-CA
                M-L08-CA
                M-L09-CA
                M-L10-CA
                M-L11-CA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-D-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CDA       (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-DATA-XA       (W0001-X)

               IF  M-DATA-XI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CDA   (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CDI (W0001-X)
               ELSE
                   MOVE M-ACT-CDI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA         TO M-ACT-CDI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-ORG-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-ORG-CI.

           MOVE M-L01-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L01-CI.

           MOVE M-L02-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L02-CI.

           MOVE M-L03-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L03-CI.

           MOVE M-L04-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L04-CI.

           MOVE M-L05-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L05-CI.

           MOVE M-L06-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L06-CI.

           MOVE M-L07-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L07-CI.

           MOVE M-L08-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L08-CI.

           MOVE M-L09-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L09-CI.

           MOVE M-L10-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L10-CI.

           MOVE M-L11-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-L11-CI.

           MOVE CA-OP-ID       TO M-UID-CDI.
           MOVE CA-FYPD        TO M-FYPDDI.
           MOVE CA-DATE        TO M-DATEDI.
           MOVE CA-TIME        TO M-TIMEDI.

           EJECT
       A300-ACCEPT-SCREEN.

           MOVE 'A300'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-NAME-1 TO MAP-NAME
               WHEN MAP-A-ACTIVE
                    MOVE MAP-NAME-A TO MAP-NAME
               WHEN MAP-B-ACTIVE
                    MOVE MAP-NAME-B TO MAP-NAME
               WHEN MAP-C-ACTIVE
                    MOVE MAP-NAME-C TO MAP-NAME
               WHEN MAP-D-ACTIVE
                    MOVE MAP-NAME-D TO MAP-NAME
           END-EVALUATE.

           EXEC CICS IGNORE CONDITION
                MAPFAIL
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS RECEIVE
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                INTO   (MAP-DATA)
           END-EXEC.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-DATA TO M231F03I
                    PERFORM A310-PROCESS-MAP-1-FIELDS
               WHEN MAP-A-ACTIVE
                    MOVE MAP-DATA TO M231F3AI
                    PERFORM A311-PROCESS-MAP-A-FIELDS
               WHEN MAP-B-ACTIVE
                    MOVE MAP-DATA TO M231F3BI
                    PERFORM A312-PROCESS-MAP-B-FIELDS
               WHEN MAP-C-ACTIVE
                    MOVE MAP-DATA TO M231F3CI
                    PERFORM A313-PROCESS-MAP-C-FIELDS
               WHEN MAP-D-ACTIVE
                    MOVE MAP-DATA TO M231F3DI
                    PERFORM A314-PROCESS-MAP-D-FIELDS
           END-EVALUATE.

           EJECT
       A310-PROCESS-MAP-1-FIELDS.

           MOVE 'A310'      TO CA-PARAGRAPH-NBR.

           INSPECT M-GRPKEY-CI REPLACING ALL '_' BY ' '.

           INSPECT M-GRPKEY-CI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   INSPECT M-ACT-CI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A311-PROCESS-MAP-A-FIELDS.

           MOVE 'A311'      TO CA-PARAGRAPH-NBR.

           INSPECT M-BKID-CAI   REPLACING ALL '_' BY ' '.
           INSPECT M-RPTGRP-CAI REPLACING ALL '_' BY ' '.
           INSPECT M-PRNT-CAI   REPLACING ALL '_' BY ' '.
           INSPECT M-CMNT-XAI   REPLACING ALL '_' BY ' '.
           INSPECT M-RPT01-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT02-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT03-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT04-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT05-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT06-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT07-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT08-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT09-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT10-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT11-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT12-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT13-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT14-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT15-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT16-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT17-CCI  REPLACING ALL '_' BY ' '.
           INSPECT M-RPT18-CCI  REPLACING ALL '_' BY ' '.

           INSPECT M-BKID-CAI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPTGRP-CAI REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-PRNT-CAI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-CMNT-XAI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT01-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT02-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT03-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT04-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT05-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT06-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT07-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT08-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT09-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT10-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT11-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT12-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT13-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT14-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT15-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT16-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT17-CCI  REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPT18-CCI  REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                   INSPECT M-PGCNT-NAI (W0001-X)
                       REPLACING ALL '_' BY ' '
                   INSPECT M-PGCNT-NAI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-TOC-XAI   (W0001-X)
                       REPLACING ALL '_' BY ' '
                   INSPECT M-TOC-XAI   (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A312-PROCESS-MAP-B-FIELDS.

           MOVE 'A312'      TO CA-PARAGRAPH-NBR.

           INSPECT M-BKID-CBI   REPLACING ALL '_' BY ' '.
           INSPECT M-RPTGRP-CBI REPLACING ALL '_' BY ' '.

           INSPECT M-BKID-CBI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPTGRP-CBI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                   INSPECT M-ACT-CBI   (W0001-X)
                       REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CBI   (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-TYPE-CBI  (W0001-X)
                       REPLACING ALL '_' BY ' '
                   INSPECT M-TYPE-CBI  (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > 11
                       INSPECT M-PRTLVL-CBI (W0001-X , W0001-IX)
                           REPLACING ALL '_' BY ' '
                       INSPECT M-PRTLVL-CBI (W0001-X , W0001-IX)
                           REPLACING ALL LOW-VALUES BY ' '
               END-PERFORM
           END-PERFORM.

           EJECT
       A313-PROCESS-MAP-C-FIELDS.

           MOVE 'A313'      TO CA-PARAGRAPH-NBR.

           INSPECT M-RPTKEY-CCI REPLACING ALL '_' BY ' '.

           INSPECT M-RPTKEY-CCI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-C-LN-LIMIT
                   INSPECT M-ACT-CCI   (W0001-X)
                       REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CCI   (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A314-PROCESS-MAP-D-FIELDS.

           MOVE 'A314'      TO CA-PARAGRAPH-NBR.

           INSPECT M-ORG-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L01-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L02-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L03-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L04-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L05-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L06-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L07-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L08-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L09-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L10-CI   REPLACING ALL '_' BY ' '.
           INSPECT M-L11-CI   REPLACING ALL '_' BY ' '.

           INSPECT M-ORG-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L01-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L02-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L03-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L04-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L05-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L06-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L07-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L08-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L09-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L10-CI   REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-L11-CI   REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-D-LN-LIMIT
                   INSPECT M-ACT-CDI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CDI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       B000-PROCESS-ENTER-KEY.

           MOVE 'B000'      TO CA-PARAGRAPH-NBR.

           SET W0001-NO-LINES-SELECTED TO TRUE.

           IF  M-GRPKEY-CI > SPACES
               PERFORM B100-VALIDATE-KEY
           ELSE
               PERFORM B300-CHECK-FOR-SELECTION
               IF  NO-ERRORS
                   IF  W0001-LINES-SELECTED
                       CONTINUE
                   ELSE
                       MOVE W9999-MSG-001  TO M-MSG-22I
                       SET ERRORS          TO TRUE
                       MOVE -1             TO M-GRPKEY-CL
                   END-IF
               END-IF
           END-IF.

           EJECT
       B100-VALIDATE-KEY.

           MOVE 'B100'      TO CA-PARAGRAPH-NBR.

           MOVE M-GRPKEY-CI  TO WS-M-MAX-RPTGRP-C.
           MOVE '00'         TO WS-M-MAX-ORDER-BY.
           PERFORM C000-PROCESS-NEXT-PAGE.
           MOVE SPACES       TO M-GRPKEY-CI.

           EJECT
       B300-CHECK-FOR-SELECTION.

           MOVE 'B300'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED TO TRUE
                       MOVE M-RPTID-CI (W0001-X)
                         TO CA-CURR-F-RPTID-C
                       MOVE M-RPTID-XI (W0001-X)
                         TO CA-CURR-F-RPTID-X
                   END-IF
           END-PERFORM.

           EJECT
       B400-DISPLAY-SCREEN-1.

           MOVE 'B400'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   MOVE WS-M-F-RPTID-C    (W0001-X)
                     TO M-RPTID-CI        (W0001-X)
                   MOVE WS-M-F-RPTGRP-C   (W0001-X)
                     TO M-RPT-NI          (W0001-X)
                   MOVE WS-M-F-RPTSEQ-C   (W0001-X)
                     TO M-SEQ-NI          (W0001-X)
                   MOVE WS-M-F-RPTID-X    (W0001-X)
                     TO M-RPTID-XI        (W0001-X)
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EJECT
       C000-PROCESS-NEXT-PAGE.

           MOVE 'C000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM C200-GET-T231BOOK
               IF  W0001-IX > 1 AND <= W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                           PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       C200-GET-T231BOOK.

           MOVE 'C200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-BKID-C  TO F-BKID-C    IN DCLT231BOOK.

           MOVE WS-M-MAX-RPTGRP-C  TO F-RPTGRP-C IN DCLT231BOOK.
           MOVE WS-M-MAX-ORDER-BY  TO W0001-ORDER-BY.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-LINE-LIMIT
               EXEC SQL
                    FETCH CSR_1
                     INTO :W0001-ORDER-BY
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.F-RPT01-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-RPTGRP-C        IN DCLT231BOOK
                         TO WS-M-MIN-RPTGRP-C
                       MOVE W0001-ORDER-BY
                         TO WS-M-MIN-ORDER-BY
                   END-IF

                   MOVE F-RPT01-C         IN DCLT231BOOK
                     TO M-RPTID-CI        (W0001-IX)
                        WS-M-F-RPTID-C     (W0001-IX)
                   MOVE F-RPTGRP-C        IN DCLT231BOOK
                     TO M-RPT-NI          (W0001-IX)
                        WS-M-F-RPTGRP-C   (W0001-IX)
                   MOVE W0001-ORDER-BY
                     TO M-SEQ-NI          (W0001-IX)
                        WS-M-F-RPTSEQ-C   (W0001-IX)

                   MOVE F-RPT01-C         IN DCLT231BOOK
                     TO F-RPTID-C         IN DCLT231RPT
                   PERFORM C210-GET-RPT-DESC
                   MOVE F-RPTID-X         IN DCLT231RPT
                     TO M-RPTID-XI        (W0001-IX)
                        WS-M-F-RPTID-X    (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RPTGRP-C        IN DCLT231BOOK
             TO WS-M-MAX-RPTGRP-C.
           MOVE W0001-ORDER-BY
             TO WS-M-MAX-ORDER-BY.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EJECT
       C210-GET-RPT-DESC.

           MOVE 'C210'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT F_RPTID_X
                  INTO :DCLT231RPT.F-RPTID-X
                  FROM D231.T231RPT
                 WHERE F_RPTID_C    = :DCLT231RPT.F-RPTID-C
                   AND DB_RECTYP_C  = '1'
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-RPTID-X IN DCLT231RPT TO CA-CURR-F-RPTID-X
           ELSE
               MOVE SPACES                  TO F-RPTID-X IN DCLT231RPT
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-003  TO M-MSG-22I
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EJECT
       C400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'C400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CI        (W0001-IX)
                          M-RPT-NI        (W0001-IX)
                          M-SEQ-NI        (W0001-IX)
                          M-RPTID-CI      (W0001-IX)
                          M-RPTID-XI      (W0001-IX)
                          WS-M-F-RPTID-C  (W0001-IX)
                          WS-M-F-RPTGRP-C (W0001-IX)
                          WS-M-F-RPTSEQ-C (W0001-IX)
                          WS-M-F-RPTID-X  (W0001-IX).

           EJECT
       D000-PROCESS-PREV-PAGE.

           MOVE 'D000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM D200-GET-T231BOOK
               IF  W0001-IX >= 1 AND < W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CL(1)
               MOVE W9999-MSG-003 TO M-MSG-22I
           END-IF.

           EJECT
       D200-GET-T231BOOK.

           MOVE 'D200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-BKID-C  TO F-BKID-C    IN DCLT231BOOK.
           MOVE WS-M-MIN-RPTGRP-C TO F-RPTGRP-C  IN DCLT231BOOK.
           MOVE WS-M-MIN-ORDER-BY TO W0001-ORDER-BY.

           EXEC SQL
                OPEN CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-LINE-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_2
                     INTO :W0001-ORDER-BY
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.F-RPT01-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-RPT01-C         IN DCLT231BOOK
                     TO M-RPTID-CI        (W0001-IX)
                        WS-M-F-RPTID-C    (W0001-IX)
                   MOVE F-RPTGRP-C        IN DCLT231BOOK
                     TO M-RPT-NI          (W0001-IX)
                        WS-M-F-RPTGRP-C   (W0001-IX)
                   MOVE W0001-ORDER-BY
                     TO M-SEQ-NI          (W0001-IX)
                        WS-M-F-RPTSEQ-C   (W0001-IX)

                   MOVE F-RPT01-C         IN DCLT231BOOK
                     TO F-RPTID-C         IN DCLT231RPT
                   PERFORM C210-GET-RPT-DESC
                   MOVE F-RPTID-X         IN DCLT231RPT
                     TO M-RPTID-XI        (W0001-IX)
                        WS-M-F-RPTID-X    (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-LINE-LIMIT
                       MOVE F-RPTGRP-C    IN DCLT231BOOK
                         TO WS-M-MAX-RPTGRP-C
                       MOVE W0001-ORDER-BY
                         TO WS-M-MAX-ORDER-BY
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RPTGRP-C        IN DCLT231BOOK
             TO WS-M-MIN-RPTGRP-C.
           MOVE W0001-ORDER-BY
             TO WS-M-MIN-ORDER-BY.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

           EJECT
       E000-PROCESS-RPT-CURSOR.

           MOVE 'E000'      TO CA-PARAGRAPH-NBR.

           IF  M-GRPKEY-CI > SPACES
               INITIALIZE M231F3AI
               INITIALIZE WS-MAP-C-DATA-VALUES
               INITIALIZE WS-MAP-B-PRT-SEQ-VALUES
               MOVE M-BKID-CI      TO M-BKID-CAI
               MOVE M-GRPKEY-CI    TO M-RPTGRP-CAI
                                      WS-M-C-F-RPTGRP-C
               PERFORM E100-PROCESS-RPT-CURSOR
               SET MAP-A-ACTIVE    TO TRUE
               MOVE W9999-MSG-019  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           ELSE
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                    OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X TO WS-M-INDEX
                       MOVE SPACES  TO M-ACT-CI (W0001-X)
                   END-IF
               END-PERFORM

               IF  W0001-LINES-SELECTED
                   INITIALIZE M231F3AI
                   INITIALIZE WS-MAP-C-DATA-VALUES
                   INITIALIZE WS-MAP-B-PRT-SEQ-VALUES
                   MOVE M-BKID-CI
                     TO M-BKID-CAI
                   MOVE WS-M-F-RPTGRP-C (WS-M-INDEX)
                     TO M-RPTGRP-CAI
                        WS-M-C-F-RPTGRP-C
                   PERFORM E100-PROCESS-RPT-CURSOR
                   SET MAP-A-ACTIVE    TO TRUE
                   MOVE W9999-MSG-019  TO M-MSG-22AI
                   MOVE -1             TO M-PRNT-CAL
               ELSE
                   MOVE W9999-MSG-060  TO M-MSG-22I
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-GRPKEY-CL
               END-IF
           END-IF.

           EJECT
       E100-PROCESS-RPT-CURSOR.

           MOVE 'E100'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CAI
             TO F-BKID-C   IN DCLT231BOOK.
           MOVE M-RPTGRP-CAI
             TO F-RPTGRP-C IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
               EXEC SQL
                    FETCH CSR_3
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '/'
                            PERFORM E110-BUILD-COMMENT
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '2'
                            PERFORM E120-BUILD-REC-TYPE-2
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '3'
                            PERFORM E130-BUILD-REC-TYPE-3
                   END-EVALUATE
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_3
           END-EXEC.

           S T OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           END-IF.

           EJECT
       E110-BUILD-COMMENT.

           MOVE 'E110' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-X          IN DCLT231BOOK
             TO M-CMNT-XAI.

           EJECT
       E120-BUILD-REC-TYPE-2.

           MOVE 'E120' TO CA-PARAGRAPH-NBR.

           IF  W0001-IX < 8
               MOVE A-PGCNT-N         IN DCLT231BOOK
                 TO M-PGCNT-NAI (W0001-IX)
               MOVE F-BKID-X          IN DCLT231BOOK
                 TO M-TOC-XAI   (W0001-IX)
               ADD +1 TO W0001-IX
           END-IF.

           EJECT
       E130-BUILD-REC-TYPE-3.

           MOVE 'E130' TO CA-PARAGRAPH-NBR.

           MOVE F-TBL-C           IN DCLT231BOOK
             TO M-PRNT-CAI.
           MOVE F-RPT01-C         IN DCLT231BOOK
             TO M-RPT01-CCI
                WS-M-C-F-RPT01-C.
           MOVE F-RPT02-C         IN DCLT231BOOK
             TO M-RPT02-CCI
                WS-M-C-F-RPT02-C.
           MOVE F-RPT03-C         IN DCLT231BOOK
             TO M-RPT03-CCI
                WS-M-C-F-RPT03-C.
           MOVE F-RPT04-C         IN DCLT231BOOK
             TO M-RPT04-CCI
                WS-M-C-F-RPT04-C.
           MOVE F-RPT05-C         IN DCLT231BOOK
             TO M-RPT05-CCI
                WS-M-C-F-RPT05-C.
           MOVE F-RPT06-C         IN DCLT231BOOK
             TO M-RPT06-CCI
                WS-M-C-F-RPT06-C.
           MOVE F-RPT07-C         IN DCLT231BOOK
             TO M-RPT07-CCI
                WS-M-C-F-RPT07-C.
           MOVE F-RPT08-C         IN DCLT231BOOK
             TO M-RPT08-CCI
                WS-M-C-F-RPT08-C.
           MOVE F-RPT09-C         IN DCLT231BOOK
             TO M-RPT09-CCI
                WS-M-C-F-RPT09-C.
           MOVE F-RPT10-C         IN DCLT231BOOK
             TO M-RPT10-CCI
                WS-M-C-F-RPT10-C.
           MOVE F-RPT11-C         IN DCLT231BOOK
             TO M-RPT11-CCI
                WS-M-C-F-RPT11-C.
           MOVE F-RPT12-C         IN DCLT231BOOK
             TO M-RPT12-CCI
                WS-M-C-F-RPT12-C.
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO M-RPT13-CCI
                WS-M-C-F-RPT13-C.
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO M-RPT14-CCI
                WS-M-C-F-RPT14-C.
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO M-RPT15-CCI
                WS-M-C-F-RPT15-C.
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO M-RPT16-CCI
                WS-M-C-F-RPT16-C.
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO M-RPT17-CCI
                WS-M-C-F-RPT17-C.
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO M-RPT18-CCI
                WS-M-C-F-RPT18-C.


           EJECT
       F000-PROCESS-NEXT-PAGE.

           MOVE 'F000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM F200-GET-T231RPT
               IF  W0001-IX > 1 AND <= W0001-SCREEN-C-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-C-LN-LIMIT
                       PERFORM F400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-C-LN-LIMIT
                           PERFORM F400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-C-LN-LIMIT
                   PERFORM F400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       F100-VALIDATE-FIELDS.

           MOVE 'F100'      TO CA-PARAGRAPH-NBR.

           IF  M-RPTKEY-CCI > SPACES
               MOVE M-RPTKEY-CCI  TO F-RPTID-C  IN DCLT231RPT
                                     WS-M-C-MAX-RPTID-C
               PERFORM F000-PROCESS-NEXT-PAGE
               MOVE SPACES        TO M-RPTKEY-CCI
           ELSE
               MOVE W9999-MSG-073  TO M-MSG-22CI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-RPTKEY-CCL
           END-IF.

           EJECT
       F200-GET-T231RPT.

           MOVE 'F200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-C-MAX-RPTID-C TO F-RPTID-C  IN DCLT231RPT.

           EXEC SQL
                OPEN CSR_6
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-C-LN-LIMIT
               EXEC SQL
                    FETCH CSR_6
                     INTO :DCLT231RPT.F-RPTID-C
                        , :DCLT231RPT.F-RPTID-X
                        , :DCLT231RPT.F-ORG-C
                        , :DCLT231RPT.F-RGN-C
                        , :DCLT231RPT.F-PRNT-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-RPTID-C     IN DCLT231RPT
                         TO WS-M-C-MIN-RPTID-C
                   END-IF

                   MOVE F-RPTID-C         IN DCLT231RPT
                     TO M-RPTID-CCI       (W0001-IX)
                   MOVE F-RPTID-X         IN DCLT231RPT
                     TO M-RPTID-XCI       (W0001-IX)
                   MOVE F-ORG-C           IN DCLT231RPT
                     TO WS-M-C-F-ORG-C    (W0001-IX)
                   MOVE F-RGN-C           IN DCLT231RPT
                     TO WS-M-C-F-RGN-C    (W0001-IX)
                   MOVE F-PRNT-C          IN DCLT231RPT
                     TO WS-M-C-PRT-SEQ1-C (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO WS-M-C-MAX-RPTID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22CI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-RPTKEY-CCL
           END-IF.

           EXEC SQL
               CLOSE CSR_6
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-073  TO M-MSG-22CI
               MOVE -1             TO M-RPTKEY-CCL
           END-IF.

           EJECT
       F400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'F400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CCI         (W0001-IX)
                          M-RPTID-CCI       (W0001-IX)
                          M-RPTID-XCI       (W0001-IX)
                          WS-M-C-F-ORG-C    (W0001-IX)
                          WS-M-C-F-RGN-C    (W0001-IX)
                          WS-M-C-PRT-SEQ1-C (W0001-IX).

           EJECT
       F600-CHECK-FOR-SELECTION.

           MOVE 'F600'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-C-LN-LIMIT
                OR ERRORS
                   IF  M-ACT-CCI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED TO TRUE
                       PERFORM F610-VALIDATE-RPT-PRINT-SEQ
                       IF  NO-ERRORS
                           PERFORM F620-MOVE-RPTID-TO-MAP-SAVE
                           MOVE SPACES  TO M-ACT-CCI (W0001-X)
                       END-IF
                   END-IF
           END-PERFORM.

           IF  NO-ERRORS
               IF  W0001-LINES-SELECTED
                   PERFORM F630-UPDATE-T231RPT-TYPE-3
                   IF  NO-ERRORS
                       MOVE W9999-MSG-012    TO M-MSG-22CI
                       MOVE -1               TO M-RPTKEY-CCL
                       SET INSERT-SUCCESSFUL TO TRUE
                   END-IF
               ELSE
                   MOVE W9999-MSG-066  TO M-MSG-22CI
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-RPTKEY-CCL
               END-IF
           END-IF.

           EJECT
       F610-VALIDATE-RPT-PRINT-SEQ.

           MOVE 'F610'      TO CA-PARAGRAPH-NBR.

           IF  WS-M-B-F-ORG-C = SPACES
               MOVE WS-M-C-F-ORG-C    (W0001-X)  TO WS-M-B-F-ORG-C
               MOVE WS-M-C-F-RGN-C    (W0001-X)  TO WS-M-B-F-RGN-C
               MOVE WS-M-C-PRT-SEQ1-C (W0001-X)  TO WS-M-B-PRT-SEQ1-C
           ELSE
               IF  WS-M-B-F-ORG-C    = WS-M-C-F-ORG-C    (W0001-X)
               AND WS-M-B-F-RGN-C    = WS-M-C-F-RGN-C    (W0001-X)
               AND WS-M-B-PRT-SEQ1-C = WS-M-C-PRT-SEQ1-C (W0001-X)
                   CONTINUE
               ELSE
                   SET ERRORS         TO TRUE
                   MOVE -1            TO M-ACT-CCL(W0001-X)
                   MOVE W9999-MSG-072 TO M-MSG-22CI
               END-IF
           END-IF.

           EJECT
       F620-MOVE-RPTID-TO-MAP-SAVE.

           MOVE 'F620'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN WS-M-C-F-RPT01-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT01-C
               WHEN WS-M-C-F-RPT02-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT02-C
               WHEN WS-M-C-F-RPT03-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT03-C
               WHEN WS-M-C-F-RPT04-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT04-C
               WHEN WS-M-C-F-RPT05-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT05-C
               WHEN WS-M-C-F-RPT06-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT06-C
               WHEN WS-M-C-F-RPT07-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT07-C
               WHEN WS-M-C-F-RPT08-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT08-C
               WHEN WS-M-C-F-RPT09-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT09-C
               WHEN WS-M-C-F-RPT10-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT10-C
               WHEN WS-M-C-F-RPT11-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT11-C
               WHEN WS-M-C-F-RPT12-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT12-C
               WHEN WS-M-C-F-RPT13-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT13-C
               WHEN WS-M-C-F-RPT14-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT14-C
               WHEN WS-M-C-F-RPT15-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT15-C
               WHEN WS-M-C-F-RPT16-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT16-C
               WHEN WS-M-C-F-RPT17-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT17-C
               WHEN WS-M-C-F-RPT18-C EQUAL SPACES
                    MOVE M-RPTID-CCI (W0001-X)
                      TO WS-M-C-F-RPT18-C
               WHEN OTHER
                    SET ERRORS         TO TRUE
                    MOVE -1            TO M-ACT-CCL(W0001-X)
                    MOVE W9999-MSG-065 TO M-MSG-22CI
           END-EVALUATE.

           EJECT
       F630-UPDATE-T231RPT-TYPE-3.

           MOVE 'F630'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CCI
             TO F-BKID-C    IN DCLT231BOOK.
           MOVE WS-M-C-F-RPTGRP-C
             TO F-RPTGRP-C  IN DCLT231BOOK.
           MOVE '3'
             TO DB-RECTYP-C IN DCLT231BOOK.

           MOVE WS-M-C-F-RPT01-C
             TO F-RPT01-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT02-C
             TO F-RPT02-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT03-C
             TO F-RPT03-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT04-C
             TO F-RPT04-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT05-C
             TO F-RPT05-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT06-C
             TO F-RPT06-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT07-C
             TO F-RPT07-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT08-C
             TO F-RPT08-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT09-C
             TO F-RPT09-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT10-C
             TO F-RPT10-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT11-C
             TO F-RPT11-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT12-C
             TO F-RPT12-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT13-C
             TO F-RPT13-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT14-C
             TO F-RPT14-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT15-C
             TO F-RPT15-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT16-C
             TO F-RPT16-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT17-C
             TO F-RPT17-C   IN DCLT231BOOK.
           MOVE WS-M-C-F-RPT18-C
             TO F-RPT18-C   IN DCLT231BOOK.

           EXEC SQL
                UPDATE D231.T231BOOK
                   SET F_RPT01_C     = :DCLT231BOOK.F-RPT01-C
                     , F_RPT02_C     = :DCLT231BOOK.F-RPT02-C
                     , F_RPT03_C     = :DCLT231BOOK.F-RPT03-C
                     , F_RPT04_C     = :DCLT231BOOK.F-RPT04-C
                     , F_RPT05_C     = :DCLT231BOOK.F-RPT05-C
                     , F_RPT06_C     = :DCLT231BOOK.F-RPT06-C
                     , F_RPT07_C     = :DCLT231BOOK.F-RPT07-C
                     , F_RPT08_C     = :DCLT231BOOK.F-RPT08-C
                     , F_RPT09_C     = :DCLT231BOOK.F-RPT09-C
                     , F_RPT10_C     = :DCLT231BOOK.F-RPT10-C
                     , F_RPT11_C     = :DCLT231BOOK.F-RPT11-C
                     , F_RPT12_C     = :DCLT231BOOK.F-RPT12-C
                     , F_RPT13_C     = :DCLT231BOOK.F-RPT13-C
                     , F_RPT14_C     = :DCLT231BOOK.F-RPT14-C
                     , F_RPT15_C     = :DCLT231BOOK.F-RPT15-C
                     , F_RPT16_C     = :DCLT231BOOK.F-RPT16-C
                     , F_RPT17_C     = :DCLT231BOOK.F-RPT17-C
                     , F_RPT18_C     = :DCLT231BOOK.F-RPT18-C
                     , F_RPT19_C     = :DCLT231BOOK.F-RPT19-C
                     , F_RPT20_C     = :DCLT231BOOK.F-RPT20-C
                     , F_RPT21_C     = :DCLT231BOOK.F-RPT21-C
                     , F_RPT22_C     = :DCLT231BOOK.F-RPT22-C
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                   AND DB_RECTYP_C   = '3'
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               CONTINUE
           ELSE
               SET NORMAL-RC-ONLY TO TRUE
               PERFORM H500-INSERT-T231BOOK
           END-IF.

           EJECT
       G000-PROCESS-PREV-PAGE.

           MOVE 'G000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM G200-GET-T231DIST
               IF  W0001-IX >= 1 AND < W0001-SCREEN-C-LN-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM F400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING  0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-C-LN-LIMIT
                   PERFORM F400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CCL(1)
               MOVE W9999-MSG-003 TO M-MSG-22CI
           END-IF.

           EJECT
       G200-GET-T231DIST.

           MOVE 'G200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-C-MIN-RPTID-C TO F-RPTID-C  IN DCLT231RPT.

           EXEC SQL
                OPEN CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-C-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_7
                     INTO :DCLT231RPT.F-RPTID-C
                        , :DCLT231RPT.F-RPTID-X
                        , :DCLT231RPT.F-ORG-C
                        , :DCLT231RPT.F-RGN-C
                        , :DCLT231RPT.F-PRNT-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-RPTID-C         IN DCLT231RPT
                     TO M-RPTID-CCI       (W0001-IX)
                   MOVE F-RPTID-X         IN DCLT231RPT
                     TO M-RPTID-XCI       (W0001-IX)
                   MOVE F-ORG-C           IN DCLT231RPT
                     TO WS-M-C-F-ORG-C    (W0001-IX)
                   MOVE F-RGN-C           IN DCLT231RPT
                     TO WS-M-C-F-RGN-C    (W0001-IX)
                   MOVE F-PRNT-C          IN DCLT231RPT
                     TO WS-M-C-PRT-SEQ1-C (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-C-LN-LIMIT
                       MOVE F-RPTID-C     IN DCLT231RPT
                         TO WS-M-C-MAX-RPTID-C
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RPTID-C  IN DCLT231RPT
             TO WS-M-C-MIN-RPTID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22CI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-RPTKEY-CCL
           END-IF.

           EXEC SQL
               CLOSE CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-073  TO M-MSG-22CI
               MOVE -1             TO M-RPTKEY-CCL
           END-IF.

           EJECT
       H000-COPY-TO-NEW-GROUP.

           MOVE 'H000'      TO CA-PARAGRAPH-NBR.

           PERFORM H100-VALIDATE-KEYS.

           IF  NO-ERRORS
               PERFORM H200-PROCESS-COPY-CURSOR
               IF  NO-ERRORS
                   CONTINUE
               ELSE
                   PERFORM Y600-ROLLBACK
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-GRPKEY-CL
                   MOVE W9999-MSG-059  TO M-MSG-22I
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-GRPKEY-CL
               MOVE W9999-MSG-020  TO M-MSG-22I
               INITIALIZE             WS-M-MIN-VALUES
               MOVE M-GRPKEY-CI    TO WS-M-MIN-RPTGRP-C
               MOVE SPACES         TO M-ACT-CI (WS-M-INDEX)
               MOVE SPACES         TO M-GRPKEY-CI
           END-IF.

           EJECT
       H100-VALIDATE-KEYS.

           MOVE 'H100' TO CA-PARAGRAPH-NBR.

           MOVE ZEROES TO W0001-COPY-CTR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X              TO WS-M-INDEX
                       ADD +1                    TO W0001-COPY-CTR
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               IF  W0001-COPY-CTR > +1
                   MOVE W9999-MSG-038  TO M-MSG-22I
                   MOVE -1             TO M-ACT-CL(1)
                   SET ERRORS          TO TRUE
               END-IF
           ELSE
               SET ERRORS              TO TRUE
               MOVE -1                 TO M-ACT-CL(1)
               MOVE W9999-MSG-057      TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               IF  M-GRPKEY-CI = SPACES
                   MOVE W9999-MSG-058  TO M-MSG-22I
                   MOVE -1             TO M-GRPKEY-CL
                   SET ERRORS          TO TRUE
               ELSE
                   IF  M-GRPKEY-CI IS NUMERIC
                       CONTINUE
                   ELSE
                       MOVE W9999-MSG-010  TO M-MSG-22I
                       MOVE -1             TO M-GRPKEY-CL
                       SET ERRORS          TO TRUE
                   END-IF
               END-IF
           END-IF.

           EJECT
       H200-PROCESS-COPY-CURSOR.

           MOVE 'H200'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CI
             TO F-BKID-C IN DCLT231BOOK.
           MOVE WS-M-F-RPTGRP-C (WS-M-INDEX)
             TO F-RPTGRP-C IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_8
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_8
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-GRPKEY-CI TO F-RPTGRP-C IN DCLT231BOOK
                   SET DUP-KEY  TO TRUE
                   PERFORM H500-INSERT-T231BOOK
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_8
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H500-INSERT-T231BOOK.

           MOVE 'H500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231BOOK
                 ( F_BKID_C
                 , F_RPTGRP_C
                 , A_SEQ_N
                 , DB_RECTYP_C
                 , F_BKID_X
                 , F_TBL_C
                 , A_PGCNT_N
                 , F_RPT01_C
                 , F_RPT02_C
                 , F_RPT03_C
                 , F_RPT04_C
                 , F_RPT05_C
                 , F_RPT06_C
                 , F_RPT07_C
                 , F_RPT08_C
                 , F_RPT09_C
                 , F_RPT10_C
                 , F_RPT11_C
                 , F_RPT12_C
                 , F_RPT13_C
                 , F_RPT14_C
                 , F_RPT15_C
                 , F_RPT16_C
                 , F_RPT17_C
                 , F_RPT18_C
                 , F_RPT19_C
                 , F_RPT20_C
                 , F_RPT21_C
                 , F_RPT22_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231BOOK.F-BKID-C
                 , :DCLT231BOOK.F-RPTGRP-C
                 , :DCLT231BOOK.A-SEQ-N
                 , :DCLT231BOOK.DB-RECTYP-C
                 , :DCLT231BOOK.F-BKID-X
                 , :DCLT231BOOK.F-TBL-C
                 , :DCLT231BOOK.A-PGCNT-N
                 , :DCLT231BOOK.F-RPT01-C
                 , :DCLT231BOOK.F-RPT02-C
                 , :DCLT231BOOK.F-RPT03-C
                 , :DCLT231BOOK.F-RPT04-C
                 , :DCLT231BOOK.F-RPT05-C
                 , :DCLT231BOOK.F-RPT06-C
                 , :DCLT231BOOK.F-RPT07-C
                 , :DCLT231BOOK.F-RPT08-C
                 , :DCLT231BOOK.F-RPT09-C
                 , :DCLT231BOOK.F-RPT10-C
                 , :DCLT231BOOK.F-RPT11-C
                 , :DCLT231BOOK.F-RPT12-C
                 , :DCLT231BOOK.F-RPT13-C
                 , :DCLT231BOOK.F-RPT14-C
                 , :DCLT231BOOK.F-RPT15-C
                 , :DCLT231BOOK.F-RPT16-C
                 , :DCLT231BOOK.F-RPT17-C
                 , :DCLT231BOOK.F-RPT18-C
                 , :DCLT231BOOK.F-RPT19-C
                 , :DCLT231BOOK.F-RPT20-C
                 , :DCLT231BOOK.F-RPT21-C
                 , :DCLT231BOOK.F-RPT22-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       I000-DELETE-REPORT-GROUP.

           MOVE 'I000'      TO CA-PARAGRAPH-NBR.

           IF  DELETE-REQUESTED
               CONTINUE
           ELSE
               MOVE -1              TO M-GRPKEY-CL
               SET ERRORS           TO TRUE
               SET DELETE-REQUESTED TO TRUE
               MOVE W9999-MSG-024   TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               IF  M-GRPKEY-CI > SPACES
                   PERFORM I100-DELETE-T231BOOK-GROUP
                   MOVE SPACES TO M-GRPKEY-CI
                   MOVE -1                  TO M-GRPKEY-CL
                   MOVE W9999-MSG-014       TO M-MSG-22I
                   SET DELETE-NOT-REQUESTED TO TRUE
               ELSE
                   PERFORM VARYING W0001-X FROM 1 BY 1
                     UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                       IF  M-ACT-CI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           MOVE M-RPT-NI (W0001-X)   TO M-GRPKEY-CI
                           PERFORM I100-DELETE-T231BOOK-GROUP
                           MOVE SPACES  TO M-ACT-CI (W0001-X)
                           MOVE SPACES  TO M-GRPKEY-CI
                       END-IF
                   END-PERFORM

                   IF  W0001-LINES-SELECTED
                       MOVE -1                  TO M-GRPKEY-CL
                       MOVE W9999-MSG-014       TO M-MSG-22I
                       SET DELETE-NOT-REQUESTED TO TRUE
                   ELSE
                       MOVE -1                  TO M-GRPKEY-CL
                       SET ERRORS               TO TRUE
                       MOVE W9999-MSG-056       TO M-MSG-22I
                   END-IF
               END-IF
           END-IF.

           EJECT
       I100-DELETE-T231BOOK-GROUP.

           MOVE 'I100'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CI
             TO F-BKID-C IN DCLT231BOOK.
           MOVE M-GRPKEY-CI
             TO F-RPTGRP-C IN DCLT231BOOK.

           EXEC SQL
                DELETE FROM D231.T231BOOK
                 WHERE F_BKID_C        = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C      = :DCLT231BOOK.F-RPTGRP-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       J000-UPDATE-REPORT-GROUP.

           MOVE 'J000'      TO CA-PARAGRAPH-NBR.

           PERFORM J100-VALIDATE-SCREEN-FIELDS.

           IF  NO-ERRORS
               PERFORM J200-SAVE-DB-TO-WS-TABLE
           END-IF.

           IF  NO-ERRORS
               MOVE M-BKID-CAI   TO M-BKID-CI
               MOVE M-RPTGRP-CAI TO M-GRPKEY-CI
               PERFORM I100-DELETE-T231BOOK-GROUP
           END-IF.

           IF  NO-ERRORS
               MOVE ZEROES TO W0001-A-SEQ-N
               PERFORM J300-INSERT-SCREEN-VALUES
           END-IF.

           IF  NO-ERRORS
               PERFORM J400-INSERT-FROM-WS-TABLE
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-013  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           ELSE
               PERFORM Y600-ROLLBACK
           END-IF.

           EJECT
       J100-VALIDATE-SCREEN-FIELDS.

           MOVE 'J100'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               IF  M-RPT01-CCI > ' '
                   MOVE M-RPT01-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT01-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT01-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT02-CCI > ' '
                   MOVE M-RPT02-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT02-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT02-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT03-CCI > ' '
                   MOVE M-RPT03-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT03-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT03-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT04-CCI > ' '
                   MOVE M-RPT04-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT04-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT04-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT05-CCI > ' '
                   MOVE M-RPT05-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT05-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT05-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT06-CCI > ' '
                   MOVE M-RPT06-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT06-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT06-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT07-CCI > ' '
                   MOVE M-RPT07-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT07-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT07-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT08-CCI > ' '
                   MOVE M-RPT08-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT08-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT08-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT09-CCI > ' '
                   MOVE M-RPT09-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT09-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT09-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT10-CCI > ' '
                   MOVE M-RPT10-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT10-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT10-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT11-CCI > ' '
                   MOVE M-RPT11-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT11-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT11-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT12-CCI > ' '
                   MOVE M-RPT12-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT12-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT12-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT13-CCI > ' '
                   MOVE M-RPT13-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT13-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT13-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT14-CCI > ' '
                   MOVE M-RPT14-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT14-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT14-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT15-CCI > ' '
                   MOVE M-RPT15-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT15-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT15-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT16-CCI > ' '
                   MOVE M-RPT16-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT16-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT16-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT17-CCI > ' '
                   MOVE M-RPT17-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT17-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT17-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT18-CCI > ' '
                   MOVE M-RPT18-CCI
                     TO F-RPTID-C   IN DCLT231RPT
                   PERFORM J110-VALIDATE-REPORT-ID
                   IF  DB2-END-OF-FILE
                       SET ERRORS          TO TRUE
                       MOVE W9999-MSG-028  TO M-MSG-22AI
                       MOVE -1             TO M-RPT18-CCL
                   END-IF
                   IF  NO-ERRORS
                       PERFORM J120-VALIDATE-RPT-PRINT-SEQ
                       IF  ERRORS
                           MOVE W9999-MSG-072  TO M-MSG-22AI
                           MOVE -1             TO M-RPT18-CCL
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > 8
                   IF  M-PGCNT-NAI (W0001-IX) > SPACES
                       IF  M-PGCNT-NAI (W0001-IX) IS NUMERIC
                           CONTINUE
                       ELSE
                           SET ERRORS         TO TRUE
                           MOVE W9999-MSG-010 TO M-MSG-22AI
                           MOVE -1            TO M-PGCNT-NAL (W0001-IX)
                       END-IF
                   END-IF
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               IF  M-RPT01-CCI > ' '
               OR  M-RPT02-CCI > ' '
               OR  M-RPT03-CCI > ' '
               OR  M-RPT04-CCI > ' '
               OR  M-RPT05-CCI > ' '
               OR  M-RPT06-CCI > ' '
               OR  M-RPT07-CCI > ' '
               OR  M-RPT08-CCI > ' '
               OR  M-RPT09-CCI > ' '
               OR  M-RPT10-CCI > ' '
               OR  M-RPT11-CCI > ' '
               OR  M-RPT12-CCI > ' '
               OR  M-RPT13-CCI > ' '
               OR  M-RPT14-CCI > ' '
               OR  M-RPT15-CCI > ' '
               OR  M-RPT16-CCI > ' '
               OR  M-RPT17-CCI > ' '
               OR  M-RPT18-CCI > ' '
                   CONTINUE
               ELSE
                   SET ERRORS          TO TRUE
                   MOVE W9999-MSG-077  TO M-MSG-22AI
                   MOVE -1             TO M-RPT01-CCL
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-019  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           END-IF.

           EJECT
       J110-VALIDATE-REPORT-ID.

           MOVE 'J110'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT A.F_RPTID_X
                     , A.F_ORG_C
                     , A.F_RGN_C
                     , B.F_PRNT_C
                  INTO :DCLT231RPT.F-RPTID-X
                     , :DCLT231RPT.F-ORG-C
                     , :DCLT231RPT.F-RGN-C
                     , :DCLT231RPT.F-PRNT-C
                  FROM D231.T231RPT A
                     , D231.T231RPT B
                 WHERE A.F_RPTID_C    = :DCLT231RPT.F-RPTID-C
                   AND A.F_RPTID_C    = B.F_RPTID_C
                   AND A.DB_RECTYP_C  = '1'
                   AND B.DB_RECTYP_C  = '2'
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       J120-VALIDATE-RPT-PRINT-SEQ.

           MOVE 'J120'      TO CA-PARAGRAPH-NBR.

           IF  WS-M-B-F-ORG-C = SPACES
               MOVE F-ORG-C    IN DCLT231RPT  TO WS-M-B-F-ORG-C
               MOVE F-RGN-C    IN DCLT231RPT  TO WS-M-B-F-RGN-C
               MOVE F-PRNT-C   IN DCLT231RPT  TO WS-M-B-PRT-SEQ1-C
           ELSE
               IF  WS-M-B-F-ORG-C    = F-ORG-C  IN DCLT231RPT
               AND WS-M-B-F-RGN-C    = F-RGN-C  IN DCLT231RPT
               AND WS-M-B-PRT-SEQ1-C = F-PRNT-C IN DCLT231RPT
                   CONTINUE
               ELSE
                   SET ERRORS  TO TRUE
               END-IF
           END-IF.

           EJECT
       J200-SAVE-DB-TO-WS-TABLE.

           MOVE 'J200'      TO CA-PARAGRAPH-NBR.

           INITIALIZE W0003-T231BOOK-TABLE-AREA.

           MOVE M-BKID-CAI
             TO F-BKID-C   IN DCLT231BOOK.
           MOVE M-RPTGRP-CAI
             TO F-RPTGRP-C IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
               EXEC SQL
                    FETCH CSR_4
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE DCLT231BOOK
                     TO W0003-T231BOOK-TABLE-ENTRY (W0001-IX)
                   ADD +1    TO W0001-IX
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       J300-INSERT-SCREEN-VALUES.

           MOVE 'J300'      TO CA-PARAGRAPH-NBR.

           PERFORM J310-INSERT-T231BOOK-CMT.

           IF  NO-ERRORS
               PERFORM J320-INSERT-T231BOOK-TYPE-2
           END-IF.

           IF  NO-ERRORS
               PERFORM J330-INSERT-T231BOOK-TYPE-3
           END-IF.

           EJECT
       J310-INSERT-T231BOOK-CMT.

           MOVE 'J310'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231BOOK.

           MOVE M-BKID-CAI
             TO F-BKID-C           IN DCLT231BOOK.
           MOVE M-RPTGRP-CAI
             TO F-RPTGRP-C         IN DCLT231BOOK.
           MOVE '/'
             TO DB-RECTYP-C        IN DCLT231BOOK.

           MOVE M-CMNT-XAI
             TO F-BKID-X           IN DCLT231BOOK.

           ADD +1 TO W0001-A-SEQ-N
           MOVE W0001-A-SEQ-N
             TO A-SEQ-N            IN DCLT231BOOK.

           PERFORM H500-INSERT-T231BOOK.

           IF  DB2-NORMAL
               SET INSERT-SUCCESSFUL TO TRUE
           ELSE
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-022  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           END-IF.

           EJECT
       J320-INSERT-T231BOOK-TYPE-2.

           MOVE 'J320'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-IX FROM 1 BY 1
              UNTIL W0001-IX > 7
               IF  M-PGCNT-NAI (W0001-IX) > SPACES
                   PERFORM J321-INSERT-T231BOOK-TYPE-2
               END-IF
           END-PERFORM.

           IF  DB2-NORMAL
               SET INSERT-SUCCESSFUL TO TRUE
           ELSE
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-022  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           END-IF.

           EJECT
       J321-INSERT-T231BOOK-TYPE-2.

           MOVE 'J321'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231BOOK.

           MOVE M-BKID-CAI
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE '2'
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE M-RPTGRP-CAI
             TO F-RPTGRP-C        IN DCLT231BOOK.

           MOVE M-PGCNT-NAI (W0001-IX)
             TO A-PGCNT-N          IN DCLT231BOOK

           MOVE M-TOC-XAI   (W0001-IX)
             TO F-BKID-X           IN DCLT231BOOK

           ADD +1 TO W0001-A-SEQ-N
           MOVE W0001-A-SEQ-N
             TO A-SEQ-N            IN DCLT231BOOK.

           PERFORM H500-INSERT-T231BOOK.

           EJECT
       J330-INSERT-T231BOOK-TYPE-3.

           MOVE 'J330'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231BOOK.

           PERFORM J331-ADJUST-REPORT-ENTRIES.

           MOVE M-BKID-CAI
             TO F-BKID-C           IN DCLT231BOOK.
           MOVE '3'
             TO DB-RECTYP-C        IN DCLT231BOOK.
           MOVE M-RPTGRP-CAI
             TO F-RPTGRP-C         IN DCLT231BOOK.

           MOVE M-PRNT-CAI
             TO F-TBL-C            IN DCLT231BOOK

           MOVE M-RPT01-CCI
             TO F-RPT01-C          IN DCLT231BOOK
                WS-M-C-F-RPT01-C.
           MOVE M-RPT02-CCI
             TO F-RPT02-C          IN DCLT231BOOK
                WS-M-C-F-RPT02-C.
           MOVE M-RPT03-CCI
             TO F-RPT03-C          IN DCLT231BOOK
                WS-M-C-F-RPT03-C.
           MOVE M-RPT04-CCI
             TO F-RPT04-C          IN DCLT231BOOK
                WS-M-C-F-RPT04-C.
           MOVE M-RPT05-CCI
             TO F-RPT05-C          IN DCLT231BOOK
                WS-M-C-F-RPT05-C.
           MOVE M-RPT06-CCI
             TO F-RPT06-C          IN DCLT231BOOK
                WS-M-C-F-RPT06-C.
           MOVE M-RPT07-CCI
             TO F-RPT07-C          IN DCLT231BOOK
                WS-M-C-F-RPT07-C.
           MOVE M-RPT08-CCI
             TO F-RPT08-C          IN DCLT231BOOK
                WS-M-C-F-RPT08-C.
           MOVE M-RPT09-CCI
             TO F-RPT09-C          IN DCLT231BOOK
                WS-M-C-F-RPT09-C.
           MOVE M-RPT10-CCI
             TO F-RPT10-C          IN DCLT231BOOK
                WS-M-C-F-RPT10-C.
           MOVE M-RPT11-CCI
             TO F-RPT11-C          IN DCLT231BOOK
                WS-M-C-F-RPT11-C.
           MOVE M-RPT12-CCI
             TO F-RPT12-C          IN DCLT231BOOK
                WS-M-C-F-RPT12-C.
           MOVE M-RPT13-CCI
             TO F-RPT13-C          IN DCLT231BOOK
                WS-M-C-F-RPT13-C.
           MOVE M-RPT14-CCI
             TO F-RPT14-C          IN DCLT231BOOK
                WS-M-C-F-RPT14-C.
           MOVE M-RPT15-CCI
             TO F-RPT15-C          IN DCLT231BOOK
                WS-M-C-F-RPT15-C.
           MOVE M-RPT16-CCI
             TO F-RPT16-C          IN DCLT231BOOK
                WS-M-C-F-RPT16-C.
           MOVE M-RPT17-CCI
             TO F-RPT17-C          IN DCLT231BOOK
                WS-M-C-F-RPT17-C.
           MOVE M-RPT18-CCI
             TO F-RPT18-C          IN DCLT231BOOK
                WS-M-C-F-RPT18-C.

           ADD +1 TO W0001-A-SEQ-N
           MOVE W0001-A-SEQ-N
             TO A-SEQ-N            IN DCLT231BOOK.

           PERFORM H500-INSERT-T231BOOK.

           IF  DB2-NORMAL
               SET INSERT-SUCCESSFUL TO TRUE
           ELSE
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-022  TO M-MSG-22AI
               MOVE -1             TO M-PRNT-CAL
           END-IF.

           EJECT
       J331-ADJUST-REPORT-ENTRIES.

           MOVE 'J331'      TO CA-PARAGRAPH-NBR.
      *
      *    THIS PARAGRAPH WILL ADJUST THE REPORT ENTRIES SO THERE
      *    ARE NOT ANY SPACES BETWEEN THE ENTRIES.
      *
           INITIALIZE W0004-REPORT-TABLE.
           SET W0004-X TO +1.

           IF  M-RPT01-CCI > ' '
               MOVE M-RPT01-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT02-CCI > ' '
               MOVE M-RPT02-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT03-CCI > ' '
               MOVE M-RPT03-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT04-CCI > ' '
               MOVE M-RPT04-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT05-CCI > ' '
               MOVE M-RPT05-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT06-CCI > ' '
               MOVE M-RPT06-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT07-CCI > ' '
               MOVE M-RPT07-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT08-CCI > ' '
               MOVE M-RPT08-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT09-CCI > ' '
               MOVE M-RPT09-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT10-CCI > ' '
               MOVE M-RPT10-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT11-CCI > ' '
               MOVE M-RPT11-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT12-CCI > ' '
               MOVE M-RPT12-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT13-CCI > ' '
               MOVE M-RPT13-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT14-CCI > ' '
               MOVE M-RPT14-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT15-CCI > ' '
               MOVE M-RPT15-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT16-CCI > ' '
               MOVE M-RPT16-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT17-CCI > ' '
               MOVE M-RPT17-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           IF  M-RPT18-CCI > ' '
               MOVE M-RPT18-CCI
                 TO W0004-REPORT-ENTRY (W0004-X)
               SET W0004-X UP BY +1
           END-IF.

           MOVE W0004-REPORT-ENTRY (01)
             TO M-RPT01-CCI.
           MOVE W0004-REPORT-ENTRY (02)
             TO M-RPT02-CCI.
           MOVE W0004-REPORT-ENTRY (03)
             TO M-RPT03-CCI.
           MOVE W0004-REPORT-ENTRY (04)
             TO M-RPT04-CCI.
           MOVE W0004-REPORT-ENTRY (05)
             TO M-RPT05-CCI.
           MOVE W0004-REPORT-ENTRY (06)
             TO M-RPT06-CCI.
           MOVE W0004-REPORT-ENTRY (07)
             TO M-RPT07-CCI.
           MOVE W0004-REPORT-ENTRY (08)
             TO M-RPT08-CCI.
           MOVE W0004-REPORT-ENTRY (09)
             TO M-RPT09-CCI.
           MOVE W0004-REPORT-ENTRY (10)
             TO M-RPT10-CCI.
           MOVE W0004-REPORT-ENTRY (11)
             TO M-RPT11-CCI.
           MOVE W0004-REPORT-ENTRY (12)
             TO M-RPT12-CCI.
           MOVE W0004-REPORT-ENTRY (13)
             TO M-RPT13-CCI.
           MOVE W0004-REPORT-ENTRY (14)
             TO M-RPT14-CCI.
           MOVE W0004-REPORT-ENTRY (15)
             TO M-RPT15-CCI.
           MOVE W0004-REPORT-ENTRY (16)
             TO M-RPT16-CCI.
           MOVE W0004-REPORT-ENTRY (17)
             TO M-RPT17-CCI.
           MOVE W0004-REPORT-ENTRY (18)
             TO M-RPT18-CCI.

           EJECT
       J400-INSERT-FROM-WS-TABLE.

           MOVE 'J400'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-IX FROM 1 BY 1
             UNTIL W0001-IX > 500
                OR W0003-T231BOOK-TABLE-ENTRY (W0001-IX) = SPACES
                OR ERRORS

               MOVE W0003-T231BOOK-TABLE-ENTRY (W0001-IX)
                 TO DCLT231BOOK

               ADD +1 TO W0001-A-SEQ-N
               MOVE W0001-A-SEQ-N
                 TO A-SEQ-N            IN DCLT231BOOK

               PERFORM H500-INSERT-T231BOOK

               IF  DB2-NORMAL
                   SET INSERT-SUCCESSFUL TO TRUE
               ELSE
                   SET ERRORS          TO TRUE
                   MOVE W9999-MSG-022  TO M-MSG-22AI
                   MOVE -1             TO M-PRNT-CAL
               END-IF
           END-PERFORM.

           EJECT
       K000-PROCESS-PRT-SEQ-CURSOR.

           MOVE 'K000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               IF  M-GRPKEY-CI > SPACES
                   INITIALIZE M231F3BI
                   MOVE M-BKID-CI      TO M-BKID-CBI
                   MOVE M-GRPKEY-CI    TO M-RPTGRP-CBI
                   PERFORM K700-GET-T231RPT-DEFAULTS

                   IF  NO-ERRORS
                       PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                       SET MAP-B-ACTIVE    TO TRUE
                       MOVE W9999-MSG-019  TO M-MSG-22BI
                       MOVE -1             TO M-ACT-CBL(1)
                   END-IF
               ELSE
                   PERFORM VARYING W0001-X FROM 1 BY 1
                     UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                        OR W0001-LINES-SELECTED
                       IF  M-ACT-CI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           MOVE W0001-X TO WS-M-INDEX
                           MOVE SPACES  TO M-ACT-CI (W0001-X)
                       END-IF
                   END-PERFORM

                   IF  W0001-LINES-SELECTED
                       INITIALIZE M231F3BI
                       MOVE M-BKID-CI
                         TO M-BKID-CBI
                       MOVE WS-M-F-RPTGRP-C (WS-M-INDEX)
                         TO M-RPTGRP-CBI
                       PERFORM K700-GET-T231RPT-DEFAULTS

                       IF  NO-ERRORS
                           PERFORM K100-PROCESS-PRT-SEQ-CURSOR
                           SET MAP-B-ACTIVE    TO TRUE
                           MOVE W9999-MSG-019  TO M-MSG-22BI
                           MOVE -1             TO M-ACT-CBL(1)
                       END-IF
                   ELSE
                       MOVE W9999-MSG-060  TO M-MSG-22I
                       SET ERRORS          TO TRUE
                       MOVE -1             TO M-GRPKEY-CL
                   END-IF
               END-IF
           END-IF.

           EJECT
       K100-PROCESS-PRT-SEQ-CURSOR.

           MOVE 'K100'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM K110-FETCH-PRT-SEQ-CURSOR
               IF  W0001-IX > 1 AND <= W0001-SCREEN-B-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                       PERFORM K300-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                           PERFORM K300-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                   PERFORM K300-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       K110-FETCH-PRT-SEQ-CURSOR.

           MOVE 'K110'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CBI
             TO F-BKID-C   IN DCLT231BOOK.
           MOVE M-RPTGRP-CBI
             TO F-RPTGRP-C IN DCLT231BOOK.
           MOVE WS-M-B-MAX-SEQ-N
             TO A-SEQ-N    IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-B-LN-LIMIT
               EXEC SQL
                    FETCH CSR_4
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOO  F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-BKID-C         IN DCLT231BOOK
                         TO WS-M-B-MIN-BKID-C
                       MOVE F-RPTGRP-C       IN DCLT231BOOK
                         TO WS-M-B-MIN-RPTGRP-C
                       MOVE A-SEQ-N          IN DCLT231BOOK
                         TO WS-M-B-MIN-SEQ-N
                   END-IF

                   PERFORM K111-BUILD-REC-TYPE-4-5-6
               END-IF
           END-PERFORM.

           MOVE F-BKID-C         IN DCLT231BOOK
             TO WS-M-B-MAX-BKID-C.
           MOVE F-RPTGRP-C       IN DCLT231BOOK
             TO WS-M-B-MAX-RPTGRP-C.
           MOVE A-SEQ-N          IN DCLT231BOOK
             TO WS-M-B-MAX-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22BI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EXEC SQL
               CLOSE CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-003  TO M-MSG-22BI
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EJECT
       K111-BUILD-REC-TYPE-4-5-6.

           MOVE 'K111' TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '4'
                    MOVE 'LVL-1'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '5'
                    MOVE 'SEQ-1'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '6'
                    MOVE 'ALT-1'
                      TO M-TYPE-CBI (W0001-IX)
           END-EVALUATE.

           MOVE F-BKID-C             IN DCLT231BOOK
             TO WS-M-B-F-BKID-C      (W0001-IX).
           MOVE DB-RECTYP-C          IN DCLT231BOOK
             TO WS-M-B-DB-RECTYP-C   (W0001-IX).
           MOVE F-RPTGRP-C           IN DCLT231BOOK
             TO WS-M-B-F-RPTGRP-C    (W0001-IX).
           MOVE A-SEQ-N              IN DCLT231BOOK
             TO WS-M-B-A-SEQ-N       (W0001-IX).

           MOVE F-RPT01-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  1).
           MOVE F-RPT02-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  2).
           MOVE F-RPT03-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  3).
           MOVE F-RPT04-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  4).
           MOVE F-RPT05-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  5).
           MOVE F-RPT06-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  6).
           MOVE F-RPT07-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  7).
           MOVE F-RPT08-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  8).
           MOVE F-RPT09-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  9).
           MOVE F-RPT10-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 10).
           MOVE F-RPT11-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 11).

           ADD +1    TO W0001-IX.

           EVALUATE TRUE
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '4'
                    MOVE 'LVL-2'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '5'
                    MOVE 'SEQ-2'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '6'
                    MOVE 'ALT-2'
                      TO M-TYPE-CBI (W0001-IX)
           END-EVALUATE.

           MOVE F-BKID-C             IN DCLT231BOOK
             TO WS-M-B-F-BKID-C      (W0001-IX).
           MOVE DB-RECTYP-C          IN DCLT231BOOK
             TO WS-M-B-DB-RECTYP-C   (W0001-IX).
           MOVE F-RPTGRP-C           IN DCLT231BOOK
             TO WS-M-B-F-RPTGRP-C    (W0001-IX).
           MOVE A-SEQ-N              IN DCLT231BOOK
             TO WS-M-B-A-SEQ-N       (W0001-IX).

           MOVE F-RPT12-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  1).
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  2).
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  3).
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  4).
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  5).
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  6).
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  7).
           MOVE F-RPT19-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  8).
           MOVE F-RPT20-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  9).
           MOVE F-RPT21-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 10).
           MOVE F-RPT22-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 11).

           ADD +1    TO W0001-IX.

           EJECT
       K200-PROCESS-PRT-SEQ-CURSOR.

           MOVE 'K200'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM K210-FETCH-PRT-SEQ-CURSOR
               IF  W0001-IX >= 1 AND < W0001-SCREEN-B-LN-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM K300-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                   PERFORM K300-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CBL(1)
               MOVE W9999-MSG-003 TO M-MSG-22BI
           END-IF.

           EJECT
       K210-FETCH-PRT-SEQ-CURSOR.

           MOVE 'K210'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CBI
             TO F-BKID-C   IN DCLT231BOOK.
           MOVE M-RPTGRP-CBI
             TO F-RPTGRP-C IN DCLT231BOOK.
           MOVE WS-M-B-MIN-SEQ-N
             TO A-SEQ-N    IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-B-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_5
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = W0001-SCREEN-B-LN-LIMIT
                       MOVE F-BKID-C         IN DCLT231BOOK
                         TO WS-M-B-MAX-BKID-C
                       MOVE F-RPTGRP-C       IN DCLT231BOOK
                         TO WS-M-B-MAX-RPTGRP-C
                       MOVE A-SEQ-N     IN DCLT231BOOK
                         TO WS-M-B-MAX-SEQ-N
                   END-IF

                   PERFORM K211-BUILD-REC-TYPE-4-5-6
               END-IF
           END-PERFORM.

           MOVE F-BKID-C         IN DCLT231BOOK
             TO WS-M-B-MIN-BKID-C.
           MOVE F-RPTGRP-C       IN DCLT231BOOK
             TO WS-M-B-MIN-RPTGRP-C.
           MOVE A-SEQ-N          IN DCLT231BOOK
             TO WS-M-B-MIN-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22BI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EXEC SQL
               CLOSE CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22BI
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EJECT
       K211-BUILD-REC-TYPE-4-5-6.

           MOVE 'K211' TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '4'
                    MOVE 'LVL-1'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '5'
                    MOVE 'SEQ-1'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '6'
                    MOVE 'ALT-1'
                      TO M-TYPE-CBI (W0001-IX)
           END-EVALUATE.

           MOVE F-BKID-C             IN DCLT231BOOK
             TO WS-M-B-F-BKID-C      (W0001-IX).
           MOVE DB-RECTYP-C          IN DCLT231BOOK
             TO WS-M-B-DB-RECTYP-C   (W0001-IX).
           MOVE F-RPTGRP-C           IN DCLT231BOOK
             TO WS-M-B-F-RPTGRP-C    (W0001-IX).
           MOVE A-SEQ-N              IN DCLT231BOOK
             TO WS-M-B-A-SEQ-N       (W0001-IX).

           MOVE F-RPT12-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  1).
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  2).
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  3).
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  4).
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  5).
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  6).
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  7).
           MOVE F-RPT19-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  8).
           MOVE F-RPT20-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  9).
           MOVE F-RPT21-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 10).
           MOVE F-RPT22-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 11).

           SUBTRACT +1   FROM W0001-IX.

           EVALUATE TRUE
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '4'
                    MOVE 'LVL-2'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '5'
                    MOVE 'SEQ-2'
                      TO M-TYPE-CBI (W0001-IX)
               WHEN DB-RECTYP-C  IN DCLT231BOOK   = '6'
                    MOVE 'ALT-2'
                      TO M-TYPE-CBI (W0001-IX)
           END-EVALUATE.

           MOVE F-BKID-C             IN DCLT231BOOK
             TO WS-M-B-F-BKID-C      (W0001-IX).
           MOVE DB-RECTYP-C          IN DCLT231BOOK
             TO WS-M-B-DB-RECTYP-C   (W0001-IX).
           MOVE F-RPTGRP-C           IN DCLT231BOOK
             TO WS-M-B-F-RPTGRP-C    (W0001-IX).
           MOVE A-SEQ-N              IN DCLT231BOOK
             TO WS-M-B-A-SEQ-N       (W0001-IX).

           MOVE F-RPT01-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  1).
           MOVE F-RPT02-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  2).
           MOVE F-RPT03-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  3).
           MOVE F-RPT04-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  4).
           MOVE F-RPT05-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  5).
           MOVE F-RPT06-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  6).
           MOVE F-RPT07-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  7).
           MOVE F-RPT08-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  8).
           MOVE F-RPT09-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX,  9).
           MOVE F-RPT10-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 10).
           MOVE F-RPT11-C         IN DCLT231BOOK
             TO M-PRTLVL-CBI (W0001-IX, 11).

           SUBTRACT +1   FROM W0001-IX.

           EJECT
       K300-MOVE-BLANKS-TO-SCREEN.

           MOVE 'K300' TO CA-PARAGRAPH-NBR.

           MOVE SPACES
             TO M-TYPE-CBI   (W0001-IX)
                M-PRTLVL-CBI (W0001-IX,  1)
                M-PRTLVL-CBI (W0001-IX,  2)
                M-PRTLVL-CBI (W0001-IX,  3)
                M-PRTLVL-CBI (W0001-IX,  4)
                M-PRTLVL-CBI (W0001-IX,  5)
                M-PRTLVL-CBI (W0001-IX,  6)
                M-PRTLVL-CBI (W0001-IX,  7)
                M-PRTLVL-CBI (W0001-IX,  8)
                M-PRTLVL-CBI (W0001-IX,  9)
                M-PRTLVL-CBI (W0001-IX, 10)
                M-PRTLVL-CBI (W0001-IX, 11)
                WS-M-B-F-BKID-C    (W0001-IX)
                WS-M-B-F-RPTGRP-C  (W0001-IX)
                WS-M-B-DB-RECTYP-C (W0001-IX)
           MOVE ZEROES
             TO WS-M-B-A-SEQ-N (W0001-IX).

           EJECT
       K500-DELETE-PRT-SEQ-LINE.

           MOVE 'K500'      TO CA-PARAGRAPH-NBR.

           IF  DELETE-REQUESTED
               CONTINUE
           ELSE
               MOVE -1              TO M-ACT-CBL(1)
               SET ERRORS           TO TRUE
               SET DELETE-REQUESTED TO TRUE
               MOVE W9999-MSG-024   TO M-MSG-22BI
           END-IF.

           IF  NO-ERRORS
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                       IF  M-ACT-CBI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           MOVE WS-M-B-F-BKID-C   (W0001-X)
                             TO F-BKID-C          IN DCLT231BOOK
                           MOVE WS-M-B-F-RPTGRP-C (W0001-X)
                             TO F-RPTGRP-C        IN DCLT231BOOK
                           MOVE WS-M-B-A-SEQ-N    (W0001-X)
                             TO A-SEQ-N           IN DCLT231BOOK

                           PERFORM K600-DELETE-T231BOOK-LINE

                           MOVE SPACES TO M-ACT-CBI (W0001-X)
                       END-IF
               END-PERFORM

               IF  W0001-LINES-SELECTED
                   MOVE -1                  TO M-ACT-CBL(1)
                   MOVE W9999-MSG-014       TO M-MSG-22BI
                   SET DELETE-NOT-REQUESTED TO TRUE
               ELSE
                   MOVE -1                  TO M-ACT-CBL(1)
                   SET ERRORS               TO TRUE
                   MOVE W9999-MSG-025       TO M-MSG-22BI
               END-IF
           END-IF.

           EJECT
       K600-DELETE-T231BOOK-LINE.

           MOVE 'K600'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231BOOK
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                   AND A_SEQ_N       = :DCLT231BOOK.A-SEQ-N
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       K700-GET-T231RPT-DEFAULTS.

           MOVE 'K700' TO CA-PARAGRAPH-NBR.

      *
      *    GET THE PRINT SEQUENCE 1 DEFAULTS.
      *
           INITIALIZE DCLT231RPT.

           MOVE M-BKID-CBI
             TO F-BKID-C           IN DCLT231BOOK.
           MOVE M-RPTGRP-CBI
             TO F-RPTGRP-C         IN DCLT231BOOK.
           MOVE '3'
             TO DB-RECTYP-C        IN DCLT231BOOK.
           MOVE '2'
             TO DB-RECTYP-C        IN DCLT231RPT.

           PERFORM K710-SELECT-T231RPT.

           IF  DB2-NORMAL
               MOVE F-RPTFMT-C   IN DCLT231RPT
                 TO WS-M-B-PRT-SEQ1-C
               MOVE F-PD01-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-01-C
               MOVE F-PD02-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-02-C
               MOVE F-PD03-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-03-C
               MOVE F-PD04-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-04-C
               MOVE F-PD05-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-05-C
               MOVE F-PD06-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-06-C
               MOVE F-PD07-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-07-C
               MOVE F-PD08-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-08-C
               MOVE F-PD09-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-09-C
               MOVE F-PD10-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-10-C
               MOVE F-PD11-C     IN DCLT231RPT
                 TO WS-M-B-SEQ1-11-C
           ELSE
               MOVE W9999-MSG-069  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-GRPKEY-CL
           END-IF.

      *
      *    GET THE PRINT SEQUENCE 2 DEFAULTS.
      *
           IF  NO-ERRORS
               INITIALIZE DCLT231RPT

               MOVE M-BKID-CBI
                 TO F-BKID-C           IN DCLT231BOOK
               MOVE M-RPTGRP-CBI
                 TO F-RPTGRP-C         IN DCLT231BOOK
               MOVE '3'
                 TO DB-RECTYP-C        IN DCLT231BOOK
               MOVE '3'
                 TO DB-RECTYP-C        IN DCLT231RPT

               PERFORM K710-SELECT-T231RPT

               IF  DB2-NORMAL
                   MOVE F-RPTFMT-C   IN DCLT231RPT
                     TO WS-M-B-PRT-SEQ2-C
                   MOVE F-PD01-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-01-C
                   MOVE F-PD02-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-02-C
                   MOVE F-PD03-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-03-C
                   MOVE F-PD04-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-04-C
                   MOVE F-PD05-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-05-C
                   MOVE F-PD06-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-06-C
                   MOVE F-PD07-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-07-C
                   MOVE F-PD08-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-08-C
                   MOVE F-PD09-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-09-C
                   MOVE F-PD10-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-10-C
                   MOVE F-PD11-C     IN DCLT231RPT
                     TO WS-M-B-SEQ2-11-C
               ELSE
                   MOVE W9999-MSG-069  TO M-MSG-22I
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-GRPKEY-CL
               END-IF
           END-IF.

      *
      *    GET THE ORG CODE AND REGION CODE FROM THE REPORT HDR.
      *
           IF  NO-ERRORS
               INITIALIZE DCLT231RPT

               MOVE M-BKID-CBI
                 TO F-BKID-C           IN DCLT231BOOK
               MOVE M-RPTGRP-CBI
                 TO F-RPTGRP-C         IN DCLT231BOOK
               MOVE '3'
                 TO DB-RECTYP-C        IN DCLT231BOOK
               MOVE '1'
                 TO DB-RECTYP-C        IN DCLT231RPT

               PERFORM K710-SELECT-T231RPT

               IF  DB2-NORMAL
                   MOVE F-ORG-C      IN DCLT231RPT
                     TO WS-M-B-F-ORG-C
                   MOVE F-RGN-C      IN DCLT231RPT
                     TO WS-M-B-F-RGN-C
               ELSE
                   MOVE SPACES
                     TO WS-M-B-F-ORG-C
                   MOVE SPACES
                     TO WS-M-B-F-RGN-C
                   MOVE W9999-MSG-069  TO M-MSG-22I
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-GRPKEY-CL
               END-IF
           END-IF.

           EJECT
       K710-SELECT-T231RPT.

           MOVE 'K710' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT R.F_RPTID_C
                     , R.F_ORG_C
                     , R.F_RGN_C
                     , R.F_LN_C
                     , R.F_COL_C
                     , R.F_RPTID_X
                     , R.F_RPTFMT_C
                     , A.F_PRNT_C
                     , R.F_PD01_C
                     , R.F_PD02_C
                     , R.F_PD03_C
                     , R.F_PD04_C
                     , R.F_PD05_C
                     , R.F_PD06_C
                     , R.F_PD07_C
                     , R.F_PD08_C
                     , R.F_PD09_C
                     , R.F_PD10_C
                     , R.F_PD11_C
                  INTO :DCLT231RPT.F-RPTID-C
                     , :DCLT231RPT.F-ORG-C
                     , :DCLT231RPT.F-RGN-C
                     , :DCLT231RPT.F-LN-C
                     , :DCLT231RPT.F-COL-C
                     , :DCLT231RPT.F-RPTID-X
                     , :DCLT231RPT.F-RPTFMT-C
                     , :DCLT231RPT.F-PRNT-C
                     , :DCLT231RPT.F-PD01-C
                     , :DCLT231RPT.F-PD02-C
                     , :DCLT231RPT.F-PD03-C
                     , :DCLT231RPT.F-PD04-C
                     , :DCLT231RPT.F-PD05-C
                     , :DCLT231RPT.F-PD06-C
                     , :DCLT231RPT.F-PD07-C
                     , :DCLT231RPT.F-PD08-C
                     , :DCLT231RPT.F-PD09-C
                     , :DCLT231RPT.F-PD10-C
                     , :DCLT231RPT.F-PD11-C
                  FROM D231.T231RPT  R
                     , D231.T231RPT  A
                     , D231.T231BOOK B
                 WHERE R.F_RPTID_C    = B.F_RPT01_C
                   AND R.F_RPTID_C    = A.F_RPTID_C
                   AND A.DB_RECTYP_C  = '2'
                   AND R.DB_RECTYP_C  = :DCLT231RPT.DB-RECTYP-C
                   AND B.F_BKID_C     = :DCLT231BOOK.F-BKID-C
                   AND B.F_RPTGRP_C   = :DCLT231BOOK.F-RPTGRP-C
                   AND B.DB_RECTYP_C  = :DCLT231BOOK.DB-RECTYP-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       L000-UPDATE-PRT-SEQ.

           MOVE 'L000'      TO CA-PARAGRAPH-NBR.

           PERFORM L100-VALIDATE-FIELDS.

           IF  NO-ERRORS
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                   PERFORM L300-BUILD-LINE-1
                   ADD +1 TO W0001-X
                   PERFORM L400-BUILD-LINE-2
                   PERFORM L500-UPDATE-T231BOOK
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-013  TO M-MSG-22BI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EJECT
       L100-VALIDATE-FIELDS.

           MOVE 'L100'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                OR ERRORS
                   PERFORM L110-VALIDATE-LINE-1
                   ADD +1 TO W0001-X
                   PERFORM L120-VALIDATE-LINE-2
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-019  TO M-MSG-22BI
               MOVE -1             TO M-ACT-CBL(1)
           END-IF.

           EJECT
       L110-VALIDATE-LINE-1.

           MOVE 'L110'      TO CA-PARAGRAPH-NBR.

           IF  WS-M-B-DB-RECTYP-C  (W0001-X) = '4'
               PERFORM L111-VALIDATE-REC-TYPE-4
           ELSE
               IF  WS-M-B-PRT-SEQ1-C = 'O'
                   IF  M-PRTLVL-CBI (W0001-X,  1) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  2) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  3) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  4) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  5) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  6) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  7) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  8) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  9) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X, 10) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X, 11) > SPACES
                       PERFORM L112-VALIDATE-ORG-CODES
                   END-IF
               END-IF
               IF  WS-M-B-PRT-SEQ1-C = 'R'
                   PERFORM L113-VALIDATE-RGN-CODES
               END-IF
           END-IF.

           EJECT
       L111-VALIDATE-REC-TYPE-4.

           MOVE 'L111'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM VARYING W0001-IX2 FROM 1 BY 1
                 UNTIL W0001-IX2 > 11
                    OR ERRORS

                    IF  M-PRTLVL-CBI (W0001-X, W0001-IX2) > SPACES
                        IF  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-01-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-02-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-03-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-04-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-05-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-06-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-07-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-08-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-09-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-10-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ1-11-C
                            CONTINUE
                        ELSE
                            MOVE W9999-MSG-074  TO M-MSG-22BI
                            SET ERRORS          TO TRUE
                            MOVE -1 TO M-PRTLVL-CBL (W0001-X, W0001-IX2)
                        END-IF
                    END-IF
                END-PERFORM
            END-IF.

           EJECT
       L112-VALIDATE-ORG-CODES.

           MOVE 'L112'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231ORGF.

           IF  NO-ERRORS
               IF  M-PRTLVL-CBI (W0001-X,  1) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  1) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  1)
                     TO F-ORGLVL01-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  2) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  2) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  2)
                     TO F-ORGLVL02-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  3) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  3) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  3)
                     TO F-ORGLVL03-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  4) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  4) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  4)
                     TO F-ORGLVL04-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  5) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  5) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  5)
                     TO F-ORGLVL05-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  6) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  6) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  6)
                     TO F-ORGLVL06-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  7) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  7) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  7)
                     TO F-ORGLVL07-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  8) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  8) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  8)
                     TO F-ORGLVL08-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X,  9) > SPACES
               AND M-PRTLVL-CBI (W0001-X,  9) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X,  9)
                     TO F-ORGLVL09-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X, 10) > SPACES
               AND M-PRTLVL-CBI (W0001-X, 10) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X, 10)
                     TO F-ORGLVL10-C  IN DCLT231ORGF
               END-IF
               IF  M-PRTLVL-CBI (W0001-X, 11) > SPACES
               AND M-PRTLVL-CBI (W0001-X, 11) NOT EQUAL 'XX'
                   MOVE M-PRTLVL-CBI (W0001-X, 11)
                     TO F-ORGLVL11-C  IN DCLT231ORGF
               END-IF
           END-IF.

           INSPECT DCLT231ORGF REPLACING ALL '-' BY ' '.

           MOVE WS-M-B-F-ORG-C TO F-ORG-C  IN DCLT231ORGF.

           MOVE CA-OP-ID       TO A-UID-C  IN DCLT231SEC.

           EXEC SQL
                SELECT F_ORG_C
                  INTO :DCLT231ORGF.F-ORG-C
                  FROM D231.T231ORGF A
                 WHERE DB_RECTYP_C  = '2'
                   AND F_ORG_C      = :DCLT231ORGF.F-ORG-C
                   AND F_ORGLVL01_C = :DCLT231ORGF.F-ORGLVL01-C
                   AND F_ORGLVL02_C = :DCLT231ORGF.F-ORGLVL02-C
                   AND F_ORGLVL03_C = :DCLT231ORGF.F-ORGLVL03-C
                   AND F_ORGLVL04_C = :DCLT231ORGF.F-ORGLVL04-C
                   AND F_ORGLVL05_C = :DCLT231ORGF.F-ORGLVL05-C
                   AND F_ORGLVL06_C = :DCLT231ORGF.F-ORGLVL06-C
                   AND F_ORGLVL07_C = :DCLT231ORGF.F-ORGLVL07-C
                   AND F_ORGLVL08_C = :DCLT231ORGF.F-ORGLVL08-C
                   AND F_ORGLVL09_C = :DCLT231ORGF.F-ORGLVL09-C
                   AND F_ORGLVL10_C = :DCLT231ORGF.F-ORGLVL10-C
                   AND F_ORGLVL11_C = :DCLT231ORGF.F-ORGLVL11-C
                   AND EXISTS
                     ( SELECT *
                         FROM D231.T231SEC B
                        WHERE B.A_UID_C     = :DCLT231SEC.A-UID-C
                          AND B.DB_RECTYP_C = 'P'
                          AND ( B.F_AFM_C   = A.F_ORGLVL02_C
                             OR B.F_AFM_C   = A.F_ORGLVL03_C
                             OR B.F_AFM_C   = A.F_ORGLVL04_C
                             OR B.F_AFM_C   = A.F_ORGLVL05_C
                             OR B.F_AFM_C   = 'NS')
                      )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               CONTINUE
           ELSE
               MOVE W9999-MSG-075  TO M-MSG-22BI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-PRTLVL-CBL (W0001-X,  1)
           END-IF.

           EJECT
       L113-VALIDATE-RGN-CODES.

           MOVE 'L113'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RGN.

           IF  NO-ERRORS
               PERFORM VARYING W0001-IX2 FROM 1 BY 1
                 UNTIL W0001-IX2 > 11
                    OR ERRORS

                    IF  M-PRTLVL-CBI (W0001-X, W0001-IX2) > SPACES
                    AND M-PRTLVL-CBI (W0001-X, W0001-IX2) NOT EQUAL 'XX'

                        MOVE WS-M-B-F-RGN-C
                          TO F-RGN-C       IN DCLT231RGN
                        MOVE M-PRTLVL-CBI (W0001-X, W0001-IX2)
                          TO F-ORGLVL01-C  IN DCLT231RGN
                        PERFORM L114-VALIDATE-T231RGN
                    END-IF
                END-PERFORM
           END-IF.

           EJECT
       L114-VALIDATE-T231RGN.

           MOVE 'L113'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT F_RGN_X
                  INTO :DCLT231RGN.F-RGN-X
                  FROM D231.T231RGN
                 WHERE DB_RECTYP_C   = '2'
                   AND F_RGN_C       = :DCLT231RGN.F-RGN-C
                   AND (F_ORGLVL01_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL02_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL03_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL04_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL05_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL06_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL07_C = :DCLT231RGN.F-ORGLVL01-C
                     OR F_ORGLVL08_C = :DCLT231RGN.F-ORGLVL01-C)
           END-EXEC.

           SET MULTIPLE-ROWS TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
           OR  DB2-MULTIPLE-ROWS
               CONTINUE
           ELSE
               MOVE W9999-MSG-076 TO M-MSG-22BI
               SET ERRORS         TO TRUE
               MOVE -1            TO M-PRTLVL-CBL (W0001-X, W0001-IX2)
           END-IF.

           EJECT
       L120-VALIDATE-LINE-2.

           MOVE 'L120'      TO CA-PARAGRAPH-NBR.

           IF  WS-M-B-DB-RECTYP-C  (W0001-X) = '4'
               PERFORM L121-VALIDATE-REC-TYPE-4
           ELSE
               IF  WS-M-B-PRT-SEQ2-C = 'O'
                   IF  M-PRTLVL-CBI (W0001-X,  1) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  2) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  3) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  4) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  5) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  6) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  7) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  8) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X,  9) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X, 10) > SPACES
                   OR  M-PRTLVL-CBI (W0001-X, 11) > SPACES
                       PERFORM L112-VALIDATE-ORG-CODES
                   END-IF
               END-IF
               IF  WS-M-B-PRT-SEQ2-C = 'R'
                   PERFORM L113-VALIDATE-RGN-CODES
               END-IF
           END-IF.

           EJECT
       L121-VALIDATE-REC-TYPE-4.

           MOVE 'L121'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM VARYING W0001-IX2 FROM 1 BY 1
                 UNTIL W0001-IX2 > 11
                    OR ERRORS

                    IF  M-PRTLVL-CBI (W0001-X, W0001-IX2) > SPACES
                        IF  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-01-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-02-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-03-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-04-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-05-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-06-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-07-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-08-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-09-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-10-C
                        OR  M-PRTLVL-CBI (W0001-X, W0001-IX2)
                            = WS-M-B-SEQ2-11-C
                            CONTINUE
                        ELSE
                            MOVE W9999-MSG-074  TO M-MSG-22BI
                            SET ERRORS          TO TRUE
                            MOVE -1 TO M-PRTLVL-CBL (W0001-X, W0001-IX2)
                        END-IF
                    END-IF
                END-PERFORM
            END-IF.

           EJECT
       L300-BUILD-LINE-1.

           MOVE 'L300'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-B-F-BKID-C      (W0001-X)
             TO F-BKID-C             IN DCLT231BOOK.
           MOVE WS-M-B-DB-RECTYP-C   (W0001-X)
             TO DB-RECTYP-C          IN DCLT231BOOK.
           MOVE WS-M-B-F-RPTGRP-C    (W0001-X)
             TO F-RPTGRP-C           IN DCLT231BOOK.
           MOVE WS-M-B-A-SEQ-N       (W0001-X)
             TO A-SEQ-N              IN DCLT231BOOK.

           MOVE M-PRTLVL-CBI (W0001-X,  1)
             TO F-RPT01-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  2)
             TO F-RPT02-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  3)
             TO F-RPT03-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  4)
             TO F-RPT04-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  5)
             TO F-RPT05-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  6)
             TO F-RPT06-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  7)
             TO F-RPT07-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  8)
             TO F-RPT08-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  9)
             TO F-RPT09-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X, 10)
             TO F-RPT10-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X, 11)
             TO F-RPT11-C          IN DCLT231BOOK.

           EJECT
       L400-BUILD-LINE-2.

           MOVE 'L400'      TO CA-PARAGRAPH-NBR.

           MOVE M-PRTLVL-CBI (W0001-X,  1)
             TO F-RPT12-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X   2)
             TO F-RPT13-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  3)
             TO F-RPT14-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  4)
             TO F-RPT15-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  5)
             TO F-RPT16-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  6)
             TO F-RPT17-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  7)
             TO F-RPT18-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  8)
             TO F-RPT19-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X,  9)
             TO F-RPT20-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X, 10)
             TO F-RPT21-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (W0001-X, 11)
             TO F-RPT22-C          IN DCLT231BOOK.

           EJECT
       L500-UPDATE-T231BOOK.

           MOVE 'L500'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                UPDATE D231.T231BOOK
                   SET F_BKID_X      = :DCLT231BOOK.F-BKID-X
                     , F_TBL_C       = :DCLT231BOOK.F-TBL-C
                     , A_PGCNT_N     = :DCLT231BOOK.A-PGCNT-N
                     , F_RPT01_C     = :DCLT231BOOK.F-RPT01-C
                     , F_RPT02_C     = :DCLT231BOOK.F-RPT02-C
                     , F_RPT03_C     = :DCLT231BOOK.F-RPT03-C
                     , F_RPT04_C     = :DCLT231BOOK.F-RPT04-C
                     , F_RPT05_C     = :DCLT231BOOK.F-RPT05-C
                     , F_RPT06_C     = :DCLT231BOOK.F-RPT06-C
                     , F_RPT07_C     = :DCLT231BOOK.F-RPT07-C
                     , F_RPT08_C     = :DCLT231BOOK.F-RPT08-C
                     , F_RPT09_C     = :DCLT231BOOK.F-RPT09-C
                     , F_RPT10_C     = :DCLT231BOOK.F-RPT10-C
                     , F_RPT11_C     = :DCLT231BOOK.F-RPT11-C
                     , F_RPT12_C     = :DCLT231BOOK.F-RPT12-C
                     , F_RPT13_C     = :DCLT231BOOK.F-RPT13-C
                     , F_RPT14_C     = :DCLT231BOOK.F-RPT14-C
                     , F_RPT15_C     = :DCLT231BOOK.F-RPT15-C
                     , F_RPT16_C     = :DCLT231BOOK.F-RPT16-C
                     , F_RPT17_C     = :DCLT231BOOK.F-RPT17-C
                     , F_RPT18_C     = :DCLT231BOOK.F-RPT18-C
                     , F_RPT19_C     = :DCLT231BOOK.F-RPT19-C
                     , F_RPT20_C     = :DCLT231BOOK.F-RPT20-C
                     , F_RPT21_C     = :DCLT231BOOK.F-RPT21-C
                     , F_RPT22_C     = :DCLT231BOOK.F-RPT22-C
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C    = :DCLT231BOOK.F-RPTGRP-C
                   AND A_SEQ_N       = :DCLT231BOOK.A-SEQ-N
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       M000-PROCESS-ENTER-KEY.

           MOVE 'M000'      TO CA-PARAGRAPH-NBR.

           SET W0001-NO-LINES-SELECTED TO TRUE.
           INITIALIZE WS-M-D-SELECTED-VALUES.

           MOVE WS-M-B-F-ORG-C
             TO M-ORG-CI
                F-ORG-C  IN DCLT231ORGF.

      *BWM*IF  M-ORG-CI > SPACES
           IF  M-L01-CI > SPACES
               PERFORM M100-VALIDATE-KEY
           ELSE
               PERFORM M200-CHECK-FOR-SELECTION
               IF  NO-ERRORS
                   IF  ORG-SELECTED
                       MOVE W9999-MSG-064  TO M-MSG-22DI
                       SET ERRORS          TO TRUE
      *BWM*            MOVE -1             TO M-ORG-CL
                       MOVE -1             TO M-L01-CL
                   ELSE
                       MOVE W9999-MSG-001  TO M-MSG-22DI
                       SET ERRORS          TO TRUE
      *BWM*            MOVE -1             TO M-ORG-CL
                       MOVE -1             TO M-L01-CL
                   END-IF
               END-IF
           END-IF.

           EJECT
       M100-VALIDATE-KEY.

           MOVE 'M100'      TO CA-PARAGRAPH-NBR.

      *BWM*IF  M-ORG-CI > SPACES
           IF  M-L01-CI > SPACES
               MOVE M-ORG-CI     TO F-ORG-C       IN DCLT231ORGF
                                    WS-M-D-MAX-ORG-C
               MOVE M-L01-CI     TO F-ORGLVL01-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L01-C
               MOVE M-L02-CI     TO F-ORGLVL02-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L02-C
               MOVE M-L03-CI     TO F-ORGLVL03-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L03-C
               MOVE M-L04-CI     TO F-ORGLVL04-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L04-C
               MOVE M-L05-CI     TO F-ORGLVL05-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L05-C
               MOVE M-L06-CI     TO F-ORGLVL06-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L06-C
               MOVE M-L07-CI     TO F-ORGLVL07-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L07-C
               MOVE M-L08-CI     TO F-ORGLVL08-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L08-C
               MOVE M-L09-CI     TO F-ORGLVL09-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L09-C
               MOVE M-L10-CI     TO F-ORGLVL10-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L10-C
               MOVE M-L11-CI     TO F-ORGLVL11-C  IN DCLT231ORGF
                                    WS-M-D-MAX-L11-C
               MOVE ZEROES       TO A-SEQ-N       IN DCLT231ORGF
                                    WS-M-D-MAX-SEQ-N
               IF  M-L01-CI EQUAL SPACES
               AND M-L02-CI EQUAL SPACES
               AND M-L03-CI EQUAL SPACES
               AND M-L04-CI EQUAL SPACES
               AND M-L05-CI EQUAL SPACES
               AND M-L06-CI EQUAL SPACES
               AND M-L07-CI EQUAL SPACES
               AND M-L08-CI EQUAL SPACES
               AND M-L09-CI EQUAL SPACES
               AND M-L10-CI EQUAL SPACES
               AND M-L11-CI EQUAL SPACES
                   MOVE ' '      TO DB-RECTYP-C   IN DCLT231ORGF
                                    WS-M-D-MAX-RECTYP-C
               ELSE
                   MOVE '2'      TO DB-RECTYP-C   IN DCLT231ORGF
                                    WS-M-D-MAX-RECTYP-C
               END-IF
               PERFORM M110-SEARCH-FOR-ORG-KEY
               PERFORM M300-PROCESS-NEXT-PAGE
      *BWM*    MOVE SPACES TO M-ORG-CI
               MOVE SPACES TO M-L01-CI
                              M-L02-CI
                              M-L03-CI
                              M-L04-CI
                              M-L05-CI
                              M-L06-CI
                              M-L07-CI
                              M-L08-CI
                              M-L09-CI
                              M-L10-CI
                              M-L11-CI
           END-IF.

           EJECT
       M110-SEARCH-FOR-ORG-KEY.

           MOVE 'M110'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT F_ORG_C
                     , DB_RECTYP_C
                     , A_SEQ_N
                  INTO :DCLT231ORGF.F-ORG-C
                     , :DCLT231ORGF.DB-RECTYP-C
                     , :DCLT231ORGF.A-SEQ-N
                  FROM D231.T231ORGF
                 WHERE F_ORG_C       = :DCLT231ORGF.F-ORG-C
                   AND DB_RECTYP_C   = '2'
                   AND F_ORGLVL01_C  = :DCLT231ORGF.F-ORGLVL01-C
                   AND F_ORGLVL02_C  = :DCLT231ORGF.F-ORGLVL02-C
                   AND F_ORGLVL03_C  = :DCLT231ORGF.F-ORGLVL03-C
                   AND F_ORGLVL04_C  = :DCLT231ORGF.F-ORGLVL04-C
                   AND F_ORGLVL05_C  = :DCLT231ORGF.F-ORGLVL05-C
                   AND F_ORGLVL06_C  = :DCLT231ORGF.F-ORGLVL06-C
                   AND F_ORGLVL07_C  = :DCLT231ORGF.F-ORGLVL07-C
                   AND F_ORGLVL08_C  = :DCLT231ORGF.F-ORGLVL08-C
                   AND F_ORGLVL09_C  = :DCLT231ORGF.F-ORGLVL09-C
                   AND F_ORGLVL10_C  = :DCLT231ORGF.F-ORGLVL10-C
                   AND F_ORGLVL11_C  = :DCLT231ORGF.F-ORGLVL11-C
           END-EXEC.

           SET DUP-KEY TO TRUE.
           PERFORM Z900-DB2-CHECK

           IF  DB2-NORMAL
               MOVE A-SEQ-N      IN DCLT231ORGF
                 TO WS-M-D-MAX-SEQ-N
           ELSE
               PERFORM M111-FETCH-ORG-KEY-CURSOR
           END-IF.

           EJECT
       M111-FETCH-ORG-KEY-CURSOR.

           MOVE 'M111'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-D-MAX-ORG-C    TO F-ORG-C      IN DCLT231ORGF.
           MOVE WS-M-D-MAX-RECTYP-C TO DB-RECTYP-C  IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L01-C    TO F-ORGLVL01-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L02-C    TO F-ORGLVL02-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L03-C    TO F-ORGLVL03-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L04-C    TO F-ORGLVL04-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L05-C    TO F-ORGLVL05-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L06-C    TO F-ORGLVL06-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L07-C    TO F-ORGLVL07-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L08-C    TO F-ORGLVL08-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L09-C    TO F-ORGLVL09-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L10-C    TO F-ORGLVL10-C IN DCLT231ORGF.
           MOVE WS-M-D-MAX-L11-C    TO F-ORGLVL11-C IN DCLT231ORGF.

           EXEC SQL
                OPEN CSR_12
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           EXEC SQL
                FETCH CSR_12
                 INTO :DCLT231ORGF.F-ORG-C
                    , :DCLT231ORGF.DB-RECTYP-C
                    , :DCLT231ORGF.A-SEQ-N
           END-EXEC

           PERFORM Z900-DB2-CHECK

           IF  DB2-NORMAL
               MOVE A-SEQ-N      IN DCLT231ORGF
                 TO WS-M-D-MAX-SEQ-N
           END-IF.

           EXEC SQL
               CLOSE CSR_12
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       M200-CHECK-FOR-SELECTION.

           MOVE 'M200'      TO CA-PARAGRAPH-NBR.

           SET ORG-NOT-SELECTED TO TRUE.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-D-LN-LIMIT
                OR ORG-SELECTED
                   IF  M-ACT-CDI (W0001-X) > ' '
                       SET ORG-SELECTED   TO TRUE

                       MOVE WS-M-D-F-ORG-C  (W0001-X)
                         TO WS-M-D-SEL-ORG-C
                       MOVE WS-M-D-F-L01-C  (W0001-X)
                         TO WS-M-D-SEL-L01-C
                       MOVE WS-M-D-F-L02-C  (W0001-X)
                         TO WS-M-D-SEL-L02-C
                       MOVE WS-M-D-F-L03-C  (W0001-X)
                         TO WS-M-D-SEL-L03-C
                       MOVE WS-M-D-F-L04-C  (W0001-X)
                         TO WS-M-D-SEL-L04-C
                       MOVE WS-M-D-F-L05-C  (W0001-X)
                         TO WS-M-D-SEL-L05-C
                       MOVE WS-M-D-F-L06-C  (W0001-X)
                         TO WS-M-D-SEL-L06-C
                       MOVE WS-M-D-F-L07-C  (W0001-X)
                         TO WS-M-D-SEL-L07-C
                       MOVE WS-M-D-F-L08-C  (W0001-X)
                         TO WS-M-D-SEL-L08-C
                       MOVE WS-M-D-F-L09-C  (W0001-X)
                         TO WS-M-D-SEL-L09-C
                       MOVE WS-M-D-F-L10-C  (W0001-X)
                         TO WS-M-D-SEL-L10-C
                       MOVE WS-M-D-F-L11-C  (W0001-X)
                         TO WS-M-D-SEL-L11-C
                   END-IF
           END-PERFORM.

           EJECT
       M300-PROCESS-NEXT-PAGE.

           MOVE 'M300'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM M310-GET-T231ORGF
               IF  W0001-IX > 1 AND <= W0001-SCREEN-D-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-D-LN-LIMIT
                       PERFORM M400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-D-LN-LIMIT
                           PERFORM M400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-D-LN-LIMIT
                   PERFORM M400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       M310-GET-T231ORGF.

           MOVE 'M310'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-B-F-ORG-C      TO M-ORG-CI
                                       WS-M-D-MAX-ORG-C
                                       F-ORG-C      IN DCLT231ORGF.

           MOVE WS-M-D-MAX-RECTYP-C TO DB-RECTYP-C  IN DCLT231ORGF.
           MOVE WS-M-D-MAX-SEQ-N    TO A-SEQ-N      IN DCLT231ORGF.

           MOVE CA-OP-ID            TO A-UID-C      IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_10
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-D-LN-LIMIT
               EXEC SQL
                    FETCH CSR_10
                     INTO :DCLT231ORGF.F-ORG-C
                        , :DCLT231ORGF.DB-RECTYP-C
                        , :DCLT231ORGF.F-ORGLVL01-C
                        , :DCLT231ORGF.F-ORGLVL02-C
                        , :DCLT231ORGF.F-ORGLVL03-C
                        , :DCLT231ORGF.F-ORGLVL04-C
                        , :DCLT231ORGF.F-ORGLVL05-C
                        , :DCLT231ORGF.F-ORGLVL06-C
                        , :DCLT231ORGF.F-ORGLVL07-C
                        , :DCLT231ORGF.F-ORGLVL08-C
                        , :DCLT231ORGF.F-ORGLVL09-C
                        , :DCLT231ORGF.F-ORGLVL10-C
                        , :DCLT231ORGF.F-ORGLVL11-C
                        , :DCLT231ORGF.A-SEQ-N
                        , :DCLT231ORGF.F-CMNT-I
                        , :DCLT231ORGF.F-DFLTAFM-C
                        , :DCLT231ORGF.F-ORGID-C
                        , :DCLT231ORGF.F-PRNT-C
                        , :DCLT231ORGF.F-DIVAFM01-C
                        , :DCLT231ORGF.F-DIVAFM02-C
                        , :DCLT231ORGF.F-DIVAFM03-C
                        , :DCLT231ORGF.F-ORG-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-ORG-C      IN DCLT231ORGF
                         TO WS-M-D-MIN-ORG-C
                       MOVE DB-RECTYP-C  IN DCLT231ORGF
                         TO WS-M-D-MIN-RECTYP-C
                       MOVE A-SEQ-N      IN DCLT231ORGF
                         TO WS-M-D-MIN-SEQ-N
                   END-IF

                   INITIALIZE W0002-T231ORGF

                   PERFORM M311-MOVE-DATA-TO-MAP-SAVE

                   EVALUATE TRUE
                       WHEN F-CMNT-I     IN DCLT231ORGF   = '/'
                            PERFORM M320-BUILD-COMMENT
                       WHEN DB-RECTYP-C  IN DCLT231ORGF   = '1'
                            PERFORM M330-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231ORGF   = '2'
                            PERFORM M340-BUILD-REC-TYPE-2
                   END-EVALUATE

                   MOVE W0002-T231ORGF
                     TO M-DATA-XI         (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-ORG-C      IN DCLT231ORGF
             TO WS-M-D-MAX-ORG-C.
           MOVE DB-RECTYP-C  IN DCLT231ORGF
             TO WS-M-D-MAX-RECTYP-C.
           MOVE A-SEQ-N      IN DCLT231ORGF
             TO WS-M-D-MAX-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22DI
               SET ERRORS          TO TRUE
      *BWM*    MOVE -1             TO M-ORG-CL
               MOVE -1             TO M-L01-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_10
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22DI
      *BWM*    MOVE -1             TO M-ORG-CL
               MOVE -1             TO M-L01-CL
           END-IF.

           EJECT
       M311-MOVE-DATA-TO-MAP-SAVE.

           MOVE 'M311' TO CA-PARAGRAPH-NBR.

           MOVE F-ORG-C           IN DCLT231ORGF
             TO WS-M-D-F-ORG-C    (W0001-IX).
           MOVE F-ORGLVL01-C      IN DCLT231ORGF
             TO WS-M-D-F-L01-C    (W0001-IX).
           MOVE F-ORGLVL02-C      IN DCLT231ORGF
             TO WS-M-D-F-L02-C    (W0001-IX).
           MOVE F-ORGLVL03-C      IN DCLT231ORGF
             TO WS-M-D-F-L03-C    (W0001-IX).
           MOVE F-ORGLVL04-C      IN DCLT231ORGF
             TO WS-M-D-F-L04-C    (W0001-IX).
           MOVE F-ORGLVL05-C      IN DCLT231ORGF
             TO WS-M-D-F-L05-C    (W0001-IX).
           MOVE F-ORGLVL06-C      IN DCLT231ORGF
             TO WS-M-D-F-L06-C    (W0001-IX).
           MOVE F-ORGLVL07-C      IN DCLT231ORGF
             TO WS-M-D-F-L07-C    (W0001-IX).
           MOVE F-ORGLVL08-C      IN DCLT231ORGF
             TO WS-M-D-F-L08-C    (W0001-IX).
           MOVE F-ORGLVL09-C      IN DCLT231ORGF
             TO WS-M-D-F-L09-C    (W0001-IX).
           MOVE F-ORGLVL10-C      IN DCLT231ORGF
             TO WS-M-D-F-L10-C    (W0001-IX).
           MOVE F-ORGLVL11-C      IN DCLT231ORGF
             TO WS-M-D-F-L11-C    (W0001-IX).

           EJECT
       M320-BUILD-COMMENT.

           MOVE 'M320' TO CA-PARAGRAPH-NBR.

           MOVE F-ORG-X           IN DCLT231ORGF
             TO W0002-T231ORGF.

           EJECT
       M330-BUILD-REC-TYPE-1.

           MOVE 'M330' TO CA-PARAGRAPH-NBR.

           MOVE F-ORG-C           IN DCLT231ORGF
             TO M-ORG-CI.
      *BWM*  TO W0002-F-ORG-C.
           MOVE F-ORGLVL01-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL01-C.
           MOVE F-ORGLVL02-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL02-C.
           MOVE F-ORGLVL03-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL03-C.
           MOVE F-ORGLVL04-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL04-C.
           MOVE F-ORGLVL05-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL05-C.
           MOVE F-ORGLVL06-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL06-C.
           MOVE F-ORGLVL07-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL07-C.
           MOVE F-ORGLVL08-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL08-C.
           MOVE F-ORGLVL09-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL09-C.
           MOVE F-ORGLVL10-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL10-C.
           MOVE F-ORGLVL11-C      IN DCLT231ORGF
             TO W0002-F-ORGLVL11-C.

      *    MOVE F-DFLTAFM-C       IN DCLT231ORGF
      *      TO W0002-F-DFLTAFM-C.
           MOVE F-ORG-X           IN DCLT231ORGF
             TO W0002-F-ORG-X.

           EJECT
       M340-BUILD-REC-TYPE-2.

           MOVE 'M340' TO CA-PARAGRAPH-NBR.

           MOVE F-ORG-C           IN DCLT231ORGF
             TO M-ORG-CI.
      *BWM*  TO W0002-F-ORG-C.
           MOVE F-ORGLVL01-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP01-C.
           MOVE F-ORGLVL02-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP02-C.
           MOVE F-ORGLVL03-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP03-C.
           MOVE F-ORGLVL04-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP04-C.
           MOVE F-ORGLVL05-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP05-C.
           MOVE F-ORGLVL06-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP06-C.
           MOVE F-ORGLVL07-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP07-C.
           MOVE F-ORGLVL08-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP08-C.
           MOVE F-ORGLVL09-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP09-C.
           MOVE F-ORGLVL10-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP10-C.
           MOVE F-ORGLVL11-C      IN DCLT231ORGF
             TO W0002-F-ORGROLLUP11-C.

      *    MOVE F-ORGID-C         IN DCLT231ORGF
      *      TO W0002-F-ORGID-C.
      *    MOVE F-PRNT-C          IN DCLT231ORGF
      *      TO W0002-F-ORGPRNT-C.
      *    MOVE F-DIVAFM01-C      IN DCLT231ORGF
      *      TO W0002-F-DIVAFM01-C.
      *    MOVE F-DIVAFM02-C      IN DCLT231ORGF
      *      TO W0002-F-DIVAFM02-C.
      *    MOVE F-DIVAFM03-C      IN DCLT231ORGF
      *      TO W0002-F-DIVAFM03-C.
           MOVE F-ORG-X           IN DCLT231ORGF
             TO W0002-F-ORGLN-X.

           EJECT
       M400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'M400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CDI      (W0001-IX)
                          M-DATA-XI      (W0001-IX).

           EJECT
       M500-PROCESS-PREV-PAGE.

           MOVE 'M500'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM M600-GET-T231DIST
               IF  W0001-IX >= 1 AND < W0001-SCREEN-D-LN-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM M400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-D-LN-LIMIT
                   PERFORM M400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CDL(1)
               MOVE W9999-MSG-003 TO M-MSG-22DI
           END-IF.

           EJECT
       M600-GET-T231DIST.

           MOVE 'M600'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-D-MIN-ORG-C    TO F-ORG-C      IN DCLT231ORGF.
           MOVE WS-M-D-MIN-RECTYP-C TO DB-RECTYP-C  IN DCLT231ORGF.
           MOVE WS-M-D-MIN-SEQ-N    TO A-SEQ-N      IN DCLT231ORGF.

           MOVE CA-OP-ID            TO A-UID-C      IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_11
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-D-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_11
                     INTO :DCLT231ORGF.F-ORG-C
                        , :DCLT231ORGF.DB-RECTYP-C
                        , :DCLT231ORGF.F-ORGLVL01-C
                        , :DCLT231ORGF.F-ORGLVL02-C
                        , :DCLT231ORGF.F-ORGLVL03-C
                        , :DCLT231ORGF.F-ORGLVL04-C
                        , :DCLT231ORGF.F-ORGLVL05-C
                        , :DCLT231ORGF.F-ORGLVL06-C
                        , :DCLT231ORGF.F-ORGLVL07-C
                        , :DCLT231ORGF.F-ORGLVL08-C
                        , :DCLT231ORGF.F-ORGLVL09-C
                        , :DCLT231ORGF.F-ORGLVL10-C
                        , :DCLT231ORGF.F-ORGLVL11-C
                        , :DCLT231ORGF.A-SEQ-N
                        , :DCLT231ORGF.F-CMNT-I
                        , :DCLT231ORGF.F-DFLTAFM-C
                        , :DCLT231ORGF.F-ORGID-C
                        , :DCLT231ORGF.F-PRNT-C
                        , :DCLT231ORGF.F-DIVAFM01-C
                        , :DCLT231ORGF.F-DIVAFM02-C
                        , :DCLT231ORGF.F-DIVAFM03-C
                        , :DCLT231ORGF.F-ORG-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-T231ORGF

                   PERFORM M311-MOVE-DATA-TO-MAP-SAVE

                   EVALUATE TRUE
                       WHEN F-CMNT-I     IN DCLT231ORGF   = '/'
                            PERFORM M320-BUILD-COMMENT
                       WHEN DB-RECTYP-C  IN DCLT231ORGF   = '1'
                            PERFORM M330-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231ORGF   = '2'
                            PERFORM M340-BUILD-REC-TYPE-2
                   END-EVALUATE

                   MOVE W0002-T231ORGF
                     TO M-DATA-XI         (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-D-LN-LIMIT
                       MOVE F-ORG-C      IN DCLT231ORGF
                         TO WS-M-D-MAX-ORG-C
                       MOVE DB-RECTYP-C  IN DCLT231ORGF
                         TO WS-M-D-MAX-RECTYP-C
                       MOVE A-SEQ-N      IN DCLT231ORGF
                         TO WS-M-D-MAX-SEQ-N
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-ORG-C      IN DCLT231ORGF
             TO WS-M-D-MIN-ORG-C.
           MOVE DB-RECTYP-C  IN DCLT231ORGF
             TO WS-M-D-MIN-RECTYP-C.
           MOVE A-SEQ-N      IN DCLT231ORGF
             TO WS-M-D-MIN-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22DI
               SET ERRORS          TO TRUE
      *BWM*    MOVE -1             TO M-ORG-CL
               MOVE -1             TO M-L01-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_11
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22DI
      *BWM*    MOVE -1             TO M-ORG-CL
               MOVE -1             TO M-L01-CL
           END-IF.


           EJECT
       N000-ADD-PRT-LVLS.

           MOVE 'N000'      TO CA-PARAGRAPH-NBR.

           PERFORM N100-CHECK-FOR-SELECTION.

           IF  NO-ERRORS
               PERFORM N600-INCREMENT-SEQ-NBRS
               IF  NO-ERRORS
                   PERFORM N200-INSERT-T231BOOK-4-5-6
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE WS-M-B-MIN-VALUES
                 TO WS-M-B-MAX-VALUES
               SUBTRACT +1 FROM WS-M-B-MAX-SEQ-N
               PERFORM K100-PROCESS-PRT-SEQ-CURSOR
               SET INSERT-SUCCESSFUL TO TRUE
               MOVE W9999-MSG-012    TO M-MSG-22BI
               SET ERRORS            TO TRUE
               MOVE -1               TO M-ACT-CBL(1)
           END-IF.

           EJECT
       N100-CHECK-FOR-SELECTION.

           MOVE 'N100'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CBI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X  TO WS-M-INDEX
                       MOVE SPACES   TO M-ACT-CBI (W0001-X)
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               CONTINUE
           ELSE
               IF  EIBAID = DFHPF4
               AND M-TYPE-CBI (1) EQUAL SPACES
                   SET W0001-LINES-SELECTED  TO TRUE
                   MOVE +1                   TO WS-M-INDEX
                   MOVE +2                   TO WS-M-B-A-SEQ-N (1)
               ELSE
                   MOVE W9999-MSG-046  TO M-MSG-22BI
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-ACT-CBL(1)
               END-IF
           END-IF.

           EJECT
       N200-INSERT-T231BOOK-4-5-6.

           MOVE 'N200'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CBI
             TO F-BKID-C           IN DCLT231BOOK.
           MOVE M-RPTGRP-CBI
             TO F-RPTGRP-C         IN DCLT231BOOK.

           EVALUATE TRUE
               WHEN EIBAID = DFHPF4
                    PERFORM N210-GET-REPORT-DEFAULTS
                    MOVE '4'
                      TO DB-RECTYP-C  IN DCLT231BOOK
               WHEN EIBAID = DFHPF6
                    PERFORM N220-GET-SELECTED-ORG-VALUES
                    MOVE '5'
                      TO DB-RECTYP-C  IN DCLT231BOOK
               WHEN EIBAID = DFHPF9
                    PERFORM N220-GET-SELECTED-ORG-VALUES
                    MOVE '6'
                      TO DB-RECTYP-C  IN DCLT231BOOK
           END-EVALUATE.

           MOVE WS-M-B-A-SEQ-N     (WS-M-INDEX)
             TO A-SEQ-N            IN DCLT231BOOK.

           MOVE M-PRTLVL-CBI (WS-M-INDEX, 1)
             TO F-RPT01-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 2)
             TO F-RPT02-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 3)
             TO F-RPT03-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 4)
             TO F-RPT04-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 5)
             TO F-RPT05-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 6)
             TO F-RPT06-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 7)
             TO F-RPT07-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 8)
             TO F-RPT08-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 9)
             TO F-RPT09-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 10)
             TO F-RPT10-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 11)
             TO F-RPT11-C          IN DCLT231BOOK.

           ADD +1 TO WS-M-INDEX.

           MOVE M-PRTLVL-CBI (WS-M-INDEX, 1)
             TO F-RPT12-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 2)
             TO F-RPT13-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 3)
             TO F-RPT14-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 4)
             TO F-RPT15-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 5)
             TO F-RPT16-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 6)
             TO F-RPT17-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 7)
             TO F-RPT18-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 8)
             TO F-RPT19-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 9)
             TO F-RPT20-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 10)
             TO F-RPT21-C          IN DCLT231BOOK.
           MOVE M-PRTLVL-CBI (WS-M-INDEX, 11)
             TO F-RPT22-C          IN DCLT231BOOK.

           SUBTRACT +1 FROM WS-M-INDEX.

           ADD +1       TO A-SEQ-N  IN DCLT231BOOK.
           SET DUP-KEY  TO TRUE.
           PERFORM H500-INSERT-T231BOOK.

           IF  DB2-NORMAL
               SET INSERT-SUCCESSFUL TO TRUE
           ELSE
               SET ERRORS            TO TRUE
               MOVE W9999-MSG-022    TO M-MSG-22BI
               MOVE -1               TO M-ACT-CBL(1)
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-012    TO M-MSG-22BI
               MOVE -1               TO M-ACT-CBL(1)
           END-IF.

           EJECT
       N210-GET-REPORT-DEFAULTS.

           MOVE 'N210' TO CA-PARAGRAPH-NBR.

           MOVE WS-M-B-SEQ1-01-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 1)
           MOVE WS-M-B-SEQ1-02-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 2)
           MOVE WS-M-B-SEQ1-03-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 3)
           MOVE WS-M-B-SEQ1-04-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 4)
           MOVE WS-M-B-SEQ1-05-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 5)
           MOVE WS-M-B-SEQ1-06-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 6)
           MOVE WS-M-B-SEQ1-07-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 7)
           MOVE WS-M-B-SEQ1-08-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 8)
           MOVE WS-M-B-SEQ1-09-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 9)
           MOVE WS-M-B-SEQ1-10-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 10)
           MOVE WS-M-B-SEQ1-11-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 11)

           ADD +1 TO WS-M-INDEX.

           MOVE WS-M-B-SEQ2-01-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 1)
           MOVE WS-M-B-SEQ2-02-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 2)
           MOVE WS-M-B-SEQ2-03-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 3)
           MOVE WS-M-B-SEQ2-04-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 4)
           MOVE WS-M-B-SEQ2-05-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 5)
           MOVE WS-M-B-SEQ2-06-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 6)
           MOVE WS-M-B-SEQ2-07-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 7)
           MOVE WS-M-B-SEQ2-08-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 8)
           MOVE WS-M-B-SEQ2-09-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 9)
           MOVE WS-M-B-SEQ2-10-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 10)
           MOVE WS-M-B-SEQ2-11-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 11)

           SUBTRACT +1 FROM WS-M-INDEX.

           EJECT
       N220-GET-SELECTED-ORG-VALUES.

           MOVE 'N220' TO CA-PARAGRAPH-NBR.

           MOVE WS-M-D-SEL-L01-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 1).
           MOVE WS-M-D-SEL-L02-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 2).
           MOVE WS-M-D-SEL-L03-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 3).
           MOVE WS-M-D-SEL-L04-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 4).
           MOVE WS-M-D-SEL-L05-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 5).
           MOVE WS-M-D-SEL-L06-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 6).
           MOVE WS-M-D-SEL-L07-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 7).
           MOVE WS-M-D-SEL-L08-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 8).
           MOVE WS-M-D-SEL-L09-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 9).
           MOVE WS-M-D-SEL-L10-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 10).
           MOVE WS-M-D-SEL-L11-C
             TO M-PRTLVL-CBI (WS-M-INDEX, 11).

           ADD +1 TO WS-M-INDEX.

           MOVE SPACES
             TO M-PRTLVL-CBI (WS-M-INDEX, 1)
                M-PRTLVL-CBI (WS-M-INDEX, 2)
                M-PRTLVL-CBI (WS-M-INDEX, 3)
                M-PRTLVL-CBI (WS-M-INDEX, 4)
                M-PRTLVL-CBI (WS-M-INDEX, 5)
                M-PRTLVL-CBI (WS-M-INDEX, 6)
                M-PRTLVL-CBI (WS-M-INDEX, 7)
                M-PRTLVL-CBI (WS-M-INDEX, 8)
                M-PRTLVL-CBI (WS-M-INDEX, 9)
                M-PRTLVL-CBI (WS-M-INDEX, 10)
                M-PRTLVL-CBI (WS-M-INDEX, 11).

           SUBTRACT +1 FROM WS-M-INDEX.

           INITIALIZE WS-M-D-SELECTED-VALUES.

           EJECT
       N600-INCREMENT-SEQ-NBRS.

           MOVE 'N600' TO CA-PARAGRAPH-NBR.

           PERFORM N610-PROCESS-SEQUENCE-CURSOR.

           IF  NO-ERRORS
               CONTINUE
           ELSE
               PERFORM Y600-ROLLBACK
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CBL(1)
               MOVE W9999-MSG-037  TO M-MSG-22I
           END-IF.

           EJECT
       N610-PROCESS-SEQUENCE-CURSOR.

           MOVE 'N610'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CBI
             TO F-BKID-C        IN DCLT231BOOK.
           MOVE M-RPTGRP-CBI
             TO F-RPTGRP-C      IN DCLT231BOOK.
           MOVE WS-M-B-A-SEQ-N  (WS-M-INDEX)
             TO A-SEQ-N         IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_9
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_9
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE A-SEQ-N IN DCLT231BOOK
                     TO W0001-A-SEQ-N

                   ADD +1 TO A-SEQ-N IN DCLT231BOOK
                   SET DUP-KEY  TO TRUE
                   PERFORM H500-INSERT-T231BOOK

                   IF  DB2-NORMAL
                       MOVE W0001-A-SEQ-N
                         TO A-SEQ-N IN DCLT231BOOK
                       PERFORM K600-DELETE-T231BOOK-LINE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_9
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
      **===========================================================**
      **   COPYBOOK AREA FOR CICS CONTROL AND SUB-MODULES          **
      **===========================================================**
           EXEC SQL
              INCLUDE C108Z000
           END-EXEC.

           EJECT
           COPY C108Z900.

           EJECT
           COPY C108Z998.

